home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir44 / dungn32.zip / VERBS.FOR < prev   
Text File  |  1994-10-08  |  73KB  |  2,109 lines
  1. C Verb processors for DUNGEON
  2. C
  3. C COPYRIGHT 1980, 1990, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA.
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C 1-Oct-94      RMS     Fixed bugs in ANSWER, INCANT, UNTIE FROM, FILL,
  8. C                       GIVE, SHAKE, PLAY, POUR, POUR ON, TAKE, SPIN, BURN,
  9. C                       ALARM, collectives, subcripting.
  10. C                       Added COUNT, Puzzle Room entrance test.
  11. C 11-Feb-94     RMS     Fixed bug in chimney load calculation.
  12. C 30-Jan-94     RMS     Fixed bugs from MS DOS port.
  13. C 27-Jan-94     RMS     Fixed portability problem in answer array.
  14. C 25-Jan-94     RMS     Fixed bug in DIG not with shovel.
  15. C 09-Jul-92     RMS     Fixed subscript range error.
  16. C 01-Jul-92     RMS     Removed extraneous function from TAKE.
  17. C 30-Jun-92     RMS     Changed file names to lower case.
  18. C
  19. C VAPPLI- Main verb processing routine
  20. C
  21. C Declarations
  22. C
  23.       LOGICAL FUNCTION VAPPLI(RI)
  24.       IMPLICIT INTEGER (A-Z)
  25.       INCLUDE 'dparam.for'
  26.       PARAMETER (MXNOP=39,MXJOKE=64,MXSMP=99)
  27.       PARAMETER (NUMANS=16)
  28.       LOGICAL LIT,OBJACT,WASLIT
  29.       LOGICAL QEMPTY,RMDESC,CLOCKD
  30.       LOGICAL MOVETO,YESNO
  31.       LOGICAL QOPEN,EDIBLE,DRKBLE
  32.       LOGICAL TAKE,PUT,DROP,WALK
  33.       LOGICAL QHERE,FINDXT,OAPPLI,F
  34.       INTEGER JOKES(25),ANSWER(NUMANS)
  35.       CHARACTER*12 ANSSTR(NUMANS)
  36.       CHARACTER*(WRDLNT) PW(2),CH,CH2
  37. C
  38. C Functions and data
  39. C
  40.       QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
  41.       EDIBLE(R)=(OFLAG1(R).AND.FOODBT).NE.0
  42.       DRKBLE(R)=(OFLAG1(R).AND.DRNKBT).NE.0
  43.       DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
  44.      1313,5314,5319,324,325,883,884,120,120,0,0,0,0/
  45.       DATA ANSWER/0,1,2,2,3,4,4,4,4,4,5,5,5,6,7,7/
  46.       DATA ANSSTR/'TEMPLE','FOREST','30003','30,003','FLASK','RUB',
  47.      1'FONDLE','CARESS','FEEL','TOUCH','BONES','BODY',
  48.      2'SKELETON','RUSTY KNIFE','NONE','NOWHERE'/
  49.  
  50. C VAPPLI, PAGE 2
  51. C
  52.       VAPPLI=.TRUE.                             ! assume wins.
  53.       ODO2=0
  54.       ODI2=0
  55.       IF((PRSO.NE.0).AND.(PRSO.LE.OMAX)) ODO2=ODESC2(PRSO)
  56.       IF(PRSI.NE.0) ODI2=ODESC2(PRSI)           ! set up descriptors.
  57.       AV=AVEHIC(WINNER)                         ! (PRSO can be direction.)
  58.       RMK=372+RND(6)                            ! remark for hack-hacks.
  59.       IF(RI.EQ.0) GO TO 10                      ! zero is false.
  60.       IF(RI.LE.MXNOP) RETURN                    ! nop?
  61.       IF(RI.LE.MXJOKE) GO TO 20                 ! joke?
  62.       IF(RI.LE.MXSMP) GO TO 30                  ! simple verb?
  63.       WASLIT=LIT(HERE)
  64.       GO TO (
  65.      1  500, 1000, 2000, 3000, 4000, 5000, 6000, 7000, 8000, 9000,
  66.      210000,11000,12000,13000,14000,15000,16000,17000,18000,19000,
  67.      320000,21000,22000,23000,24000,25000,26000,27000,28000,29000,
  68.      430000,31000,32000,33000,34000,35000,36000,37000,38000,39000,
  69.      540000,41000,42000,43000,44000,45000,46000,47000,48000,49000,
  70.      650000,51000,52000,53000,54000,55000,56000,57000,58000,59000,
  71.      760000,61000,62000,63000,64000,65000,66000,67000,68000,69000),
  72.      9(RI-MXSMP)
  73.       CALL BUG(7,RI)
  74. C
  75. C All verb processors return here to declare failure.
  76. C
  77. 10    VAPPLI=.FALSE.                            ! lose.
  78.       RETURN
  79. C
  80. C Joke processor.
  81. C Find proper entry in jokes, use it to select string to print.
  82. C
  83. 20    I=JOKES(RI-MXNOP)                         ! get table entry.
  84.       J=I/1000                                  ! isolate # strings.
  85.       IF(J.NE.0) I=MOD(I,1000)+RND(J)           ! if random, choose.
  86.       CALL RSPEAK(I)                            ! print joke.
  87.       RETURN
  88. C
  89. C 'Simple' verbs.
  90. C
  91. 30    GO TO (65001,66001,67001,68001,69001,
  92.      170000,71000,72000,73000,74000,75000,76000,77000,78000,79000,
  93.      280000,81000,82000,83000,84000,85000,86000,87000,88000,89000,
  94.      390000,91000,92000,93000,94000,95000,96000,97000),
  95.      9(RI-MXJOKE)
  96.       CALL BUG(7,RI)
  97. C
  98. C Here to test for change in light.
  99. C
  100. 50    IF(WASLIT.AND..NOT.LIT(HERE)) CALL RSPEAK(406)
  101.       RETURN
  102.  
  103. C VAPPLI, PAGE 3
  104. C
  105. C V100--        Read
  106. C
  107. 500   IF(LIT(HERE)) GO TO 600                   ! room lit?
  108.       CALL RSPEAK(356)                          ! no, cant read.
  109.       RETURN
  110. C
  111. 600   IF(PRSI.EQ.0) GO TO 700                   ! read through obj?
  112.       IF((OFLAG1(PRSI).AND.TRANBT).NE.0) GO TO 700
  113.       CALL RSPSUB(357,ODI2)                     ! not transparent.
  114.       RETURN
  115. C
  116. 700   IF(OBJACT(X)) RETURN                      ! object handle?
  117.       IF((OFLAG1(PRSO).AND.READBT).NE.0) GO TO 800
  118.       CALL RSPSUB(358,ODO2)                     ! not readable.
  119.       RETURN
  120. C
  121. 800   CALL RSPEAK(OREAD(PRSO))                  ! print reading material.
  122.       RETURN
  123. C
  124. C V101--        Melt
  125. C
  126. 1000  IF(.NOT.OBJACT(X)) CALL RSPSUB(361,ODO2)
  127.       RETURN
  128. C
  129. C V102--        Inflate
  130. C
  131. 2000  IF(.NOT.OBJACT(X)) CALL RSPEAK(368)       ! obj handle?
  132.       RETURN
  133. C
  134. C V103--        Deflate.
  135. C
  136. 3000  IF(.NOT.OBJACT(X)) CALL RSPEAK(369)       ! obj handle?
  137.       RETURN
  138.  
  139. C VAPPLI, PAGE 4
  140. C
  141. C V104--        Alarm
  142. C
  143. 4000  IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 4100 ! villain?
  144.       CALL RSPEAK(552+RND(6))                   ! no, joke.
  145.       RETURN
  146. C
  147. 4100  IF(.NOT.OBJACT(X)) CALL RSPSUB(370,ODO2)
  148.       RETURN
  149. C
  150. C V105--        Exorcise
  151. C
  152. 5000  F=OBJACT(X)                               ! objects handle.
  153.       RETURN
  154. C
  155. C V106--        Plug
  156. C
  157. 6000  IF(.NOT.OBJACT(X)) CALL RSPEAK(371)
  158.       RETURN
  159. C
  160. C V107--        Kick
  161. C
  162. 7000  IF(.NOT.OBJACT(X)) CALL RSPSB2(378,ODO2,RMK)
  163.       RETURN
  164. C
  165. C V108--        Wave
  166. C
  167. 8000  IF(.NOT.OBJACT(X)) CALL RSPSB2(379,ODO2,RMK)
  168.       RETURN
  169. C
  170. C V109,V110--   Raise, lower
  171. C
  172. 9000  CONTINUE
  173. 10000 IF(.NOT.OBJACT(X)) CALL RSPSB2(380,ODO2,RMK)
  174.       RETURN
  175. C
  176. C V111--        Rub
  177. C
  178. 11000 IF(.NOT.OBJACT(X)) CALL RSPSB2(381,ODO2,RMK)
  179.       RETURN
  180. C
  181. C V112--        Push
  182. C
  183. 12000 IF(.NOT.OBJACT(X)) CALL RSPSB2(382,ODO2,RMK)
  184.       RETURN
  185.  
  186. C VAPPLI, PAGE 5
  187. C
  188. C V113--        Untie
  189. C
  190. 13000 IF(OBJACT(X)) RETURN                      ! object handle?
  191.       I=383                                     ! no, not tied.
  192.       IF((OFLAG2(PRSO).AND.TIEBT).EQ.0) I=384   ! not tieable.
  193.       CALL RSPEAK(I)
  194.       RETURN
  195. C
  196. C V114--        Tie
  197. C
  198. 14000 IF((OFLAG2(PRSO).AND.TIEBT).NE.0) GO TO 14100
  199.       CALL RSPEAK(385)                          ! not tieable.
  200.       RETURN
  201. C
  202. 14100 IF(OBJACT(X)) RETURN                      ! object handle?
  203.       I=386                                     ! joke 1.
  204.       IF(PRSI.EQ.OPLAY) I=919                   ! if player, joke 2.
  205.       CALL RSPSUB(386,ODO2)                     ! print remark.
  206.       RETURN
  207. C
  208. C V115--        Tie up
  209. C
  210. 15000 IF((OFLAG2(PRSI).AND.TIEBT).NE.0) GO TO 15100
  211.       CALL RSPSUB(387,ODO2)                     ! not tieable.
  212.       RETURN
  213. C
  214. 15100 I=388                                     ! assume villain.
  215.       IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) I=389
  216.       CALL RSPSUB(I,ODO2)                       ! joke.
  217.       RETURN
  218. C
  219. C V116--        Turn
  220. C
  221. 16000 IF((OFLAG1(PRSO).AND.TURNBT).NE.0) GO TO 16100
  222.       CALL RSPEAK(390)                          ! not turnable.
  223.       RETURN
  224. C
  225. 16100 IF((OFLAG1(PRSI).AND.TOOLBT).NE.0) GO TO 16200
  226.       CALL RSPSUB(391,ODI2)                     ! not a tool.
  227.       RETURN
  228. C
  229. 16200 VAPPLI=OBJACT(X)                          ! let object handle.
  230.       RETURN
  231. C
  232. C V117--        Breathe
  233. C
  234. 17000 PRSA=INFLAW
  235.       PRSI=LUNGS
  236.       GO TO 2000                                ! handle like inflate.
  237.  
  238. C VAPPLI, PAGE 5A.
  239. C
  240. C V118--        Knock
  241. C
  242. 18000 IF(OBJACT(X)) RETURN                      ! obj handle?
  243.       I=394                                     ! joke for door.
  244.       IF((OFLAG1(PRSO).AND.DOORBT).EQ.0) I=395
  245.       CALL RSPSUB(I,ODO2)                       ! joke for nondoors too.
  246.       RETURN
  247. C
  248. C V119--        Look
  249. C
  250. 19000 IF(PRSO.NE.0) GO TO 20500                 ! something to look at?
  251.       VAPPLI=RMDESC(3)                          ! handled by rmdesc.
  252.       RETURN
  253. C
  254. C V120--        Examine
  255. C
  256. 20000 IF(PRSO.NE.0) GO TO 20500                 ! something to examine?
  257.       VAPPLI=RMDESC(0)                          ! handled by rmdesc.
  258.       RETURN
  259. C
  260. 20500 IF(OBJACT(X)) RETURN                      ! obj handle?
  261.       I=OREAD(PRSO)                             ! get reading material.
  262.       IF(I.NE.0) CALL RSPEAK(I)                 ! output if there,
  263.       IF(I.EQ.0) CALL RSPSUB(429,ODO2)          ! otherwise default.
  264.       PRSA=FOOW                                 ! defuse room processors.
  265.       RETURN
  266. C
  267. C V121--        Shake
  268. C
  269. 21000 IF(OBJACT(X)) RETURN                      ! object handle?
  270.       IF(PRSO.EQ.GWATE) GO TO 10                ! global water? fails.
  271.       IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 21100
  272.       CALL RSPEAK(371)                          ! joke for villains.
  273.       RETURN
  274. C
  275. 21100 IF(PRSO.NE.AV) GO TO 21150                ! vehicle?
  276.       CALL RSPEAK(672)                          ! yes, joke.
  277.       RETURN
  278. C
  279. 21150 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 21200 ! takeable?
  280.       CALL RSPEAK(923)                          ! no, joke.
  281.       RETURN
  282. C
  283. 21200 IF(OADV(PRSO).EQ.WINNER) GO TO 21250      ! carrying?
  284.       CALL RSPEAK(527)                          ! no, joke.
  285.       RETURN
  286. C
  287. 21250 IF(QEMPTY(PRSO)) GO TO 10                 ! empty?  fails.
  288.       IF(QOPEN(PRSO)) GO TO 21300               ! open?  spill.
  289.       CALL RSPSUB(396,ODO2)                     ! no, describe noise.
  290.       RETURN
  291. C
  292. 21300 CALL RSPSUB(397,ODO2)                     ! spill the works.
  293.       DO 21500 I=1,OLNT                         ! spill contents.
  294.         IF(OCAN(I).NE.PRSO) GO TO 21500         ! inside?
  295.         OFLAG2(I)=OFLAG2(I).OR.TCHBT            ! touch object.
  296.         IF(AV.EQ.0) GO TO 21400                 ! in vehicle?
  297.         CALL NEWSTA(I,0,0,AV,0)                 ! yes, spill in there.
  298.         GO TO 21500
  299. C
  300. 21400   CALL NEWSTA(I,0,HERE,0,0)               ! no, spill on floor,
  301.         IF(I.EQ.WATER) CALL NEWSTA(I,133,0,0,0) ! but water disappears.
  302. 21500 CONTINUE
  303.       RETURN
  304.  
  305. C VAPPLI, PAGE 6
  306. C
  307. C V122--        Move
  308. C
  309. 22000 IF(.NOT.QHERE(PRSO,HERE)) GO TO 22100     ! is it here?
  310.       IF(OBJACT(X)) RETURN                      ! obj handle?
  311.       I=399                                     ! assume not takeable.
  312.       IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) I=887
  313.       CALL RSPSUB(I,ODO2)                       ! joke.
  314.       RETURN
  315. C
  316. 22100 CALL RSPEAK(398)                          ! not here.
  317.       RETURN
  318. C
  319. C V123--        Turn on
  320. C
  321. 23000 IF(OBJACT(X)) RETURN                      ! object handle?
  322.       IF(((OFLAG1(PRSO).AND.LITEBT).NE.0).AND.
  323.      1(OADV(PRSO).EQ.WINNER)) GO TO 23100
  324.       CALL RSPEAK(400)                          ! cant do it.
  325.       RETURN
  326. C
  327. 23100 IF((OFLAG1(PRSO).AND.ONBT).EQ.0) GO TO 23200
  328.       CALL RSPEAK(401)                          ! already on.
  329.       RETURN
  330. C
  331. 23200 OFLAG1(PRSO)=OFLAG1(PRSO).OR.ONBT         ! turn it on.
  332.       CALL RSPSUB(404,ODO2)
  333.       RETURN
  334. C
  335. C V124--        Turn off
  336. C
  337. 24000 IF(OBJACT(X)) RETURN                      ! obj handle?
  338.       IF(((OFLAG1(PRSO).AND.LITEBT).NE.0).AND.
  339.      1(OADV(PRSO).EQ.WINNER)) GO TO 24100
  340.       CALL RSPEAK(402)                          ! cant do it.
  341.       RETURN
  342. C
  343. 24100 IF((OFLAG1(PRSO).AND.ONBT).NE.0) GO TO 24200
  344.       CALL RSPEAK(403)                          ! already off.
  345.       RETURN
  346. C
  347. 24200 OFLAG1(PRSO)=OFLAG1(PRSO).AND. .NOT.ONBT
  348.       CALL RSPSUB(405,ODO2)
  349.       GO TO 50                                  ! go see if now dark.
  350. C
  351. C V125--        Open
  352. C
  353. 25000 IF(OBJACT(X)) RETURN                      ! obj handle?
  354.       IF((OFLAG1(PRSO).AND.DOORBT).NE.0) GO TO 25150 ! door?
  355.       IF((OFLAG1(PRSO).AND.CONTBT).NE.0) GO TO 25100 ! container?
  356. 25050 CALL RSPSUB(407,ODO2)                     ! not door or container.
  357.       RETURN
  358. C
  359. 25100 IF(OCAPAC(PRSO).NE.0) GO TO 25200         ! openable container?
  360. 25150 CALL RSPSUB(408,ODO2)                     ! door or not openable.
  361.       RETURN
  362. C
  363. 25200 IF(.NOT.QOPEN(PRSO)) GO TO 25225
  364.       CALL RSPEAK(412)                          ! already open.
  365.       RETURN
  366. C
  367. 25225 OFLAG2(PRSO)=OFLAG2(PRSO).OR.OPENBT       ! open it.
  368.       IF(((OFLAG1(PRSO).AND.TRANBT).NE.0).OR.QEMPTY(PRSO))
  369.      1GO TO 25300
  370.       CALL PRINCO(PRSO,410,.FALSE.)             ! print contents.
  371.       RETURN
  372. C
  373. 25300 CALL RSPEAK(409)                          ! done
  374.       RETURN
  375. C
  376. C V126--        Close
  377. C
  378. 26000 IF(OBJACT(X)) RETURN                      ! obj handle?
  379.       IF((OFLAG1(PRSO).AND.DOORBT).NE.0) GO TO 26050 ! door?
  380.       IF((OFLAG1(PRSO).AND.CONTBT).EQ.0) GO TO 25050 ! container?
  381.       IF(OCAPAC(PRSO).NE.0) GO TO 26100         ! closable container?
  382. 26050 CALL RSPSUB(411,ODO2)                     ! door or not closable.
  383.       RETURN
  384. C
  385. 26100 IF(QOPEN(PRSO)) GO TO 26200               ! open?
  386.       CALL RSPEAK(413)                          ! no, joke.
  387.       RETURN
  388. C
  389. 26200 OFLAG2(PRSO)=OFLAG2(PRSO).AND. .NOT.OPENBT
  390.       CALL RSPEAK(414)                          ! done.
  391.       GO TO 50                                  ! go see if now dark.
  392.  
  393. C VAPPLI, PAGE 7
  394. C
  395. C V127--        Find
  396. C
  397. 27000 IF(OBJACT(X)) RETURN                      ! obj handle?
  398.       I=415                                     ! room string.
  399.       IF(QHERE(PRSO,HERE)) GO TO 27200          ! in room?
  400.       I=416                                     ! winner string.
  401.       IF(OADV(PRSO).EQ.WINNER) GO TO 27200      ! on winner?
  402.       J=OCAN(PRSO)                              ! down one level.
  403.       IF(J.EQ.0) GO TO 10
  404.       IF((((OFLAG1(J).AND.TRANBT).EQ.0).AND.
  405.      2(.NOT.QOPEN(J).OR.((OFLAG1(J).AND.(DOORBT+CONTBT)).EQ.0))))
  406.      3GO TO 10                                  ! if not visible, punt.
  407.       I=417                                     ! assume in room.
  408.       IF(QHERE(J,HERE)) GO TO 27100
  409.       I=418                                     ! assume on winner.
  410.       IF(OADV(J).NE.WINNER) GO TO 10            ! not here or on person.
  411. 27100 CALL RSPSUB(I,ODESC2(J))                  ! describe findings.
  412.       RETURN
  413. C
  414. 27200 CALL RSPSUB(I,ODO2)                       ! describe findings.
  415.       RETURN
  416. C
  417. C V128--        Wait
  418. C
  419. 28000 CALL RSPEAK(419)                          ! time passes.
  420.       DO 28100 I=1,3
  421.         IF(CLOCKD(X)) RETURN
  422.         IF(.NOT.DEADF) CALL FIGHTD
  423.         IF(PRSCON.EQ.0) RETURN                  ! fighting happened.
  424. 28100 CONTINUE
  425.       RETURN
  426. C
  427. C V129--        Spin
  428. C V159--        Turn to
  429. C
  430. 29000 CONTINUE
  431. 59000 IF(OBJACT(X)) RETURN                      ! object handle?
  432.       IF((OFLAG1(PRSO).AND.TURNBT).NE.0) GO TO 59100
  433.       CALL RSPEAK(390)                          ! can't turn?
  434.       RETURN
  435. C
  436. 59100 CALL RSPSUB(663,ODO2)                     ! won't budge.
  437.       RETURN
  438. C
  439. C V130--        Board
  440. C
  441. 30000 IF((OFLAG2(PRSO).AND.VEHBT).NE.0) GO TO 30100
  442.       CALL RSPSUB(421,ODO2)                     ! not vehicle, joke.
  443.       PRSCON=0                                  ! kill cmd stream.
  444.       RETURN
  445. C
  446. 30100 IF(QHERE(PRSO,HERE)) GO TO 30200          ! here?
  447.       CALL RSPSUB(420,ODO2)                     ! no, joke.
  448.       PRSCON=0                                  ! kill cmd stream.
  449.       RETURN
  450. C
  451. 30200 IF(AV.EQ.0) GO TO 30300                   ! already got one?
  452.       CALL RSPSUB(422,ODO2)                     ! yes, joke.
  453.       PRSCON=0                                  ! kill cmd stream.
  454.       RETURN
  455. C
  456. 30300 IF(OBJACT(X)) RETURN                      ! obj handle?
  457.       CALL RSPSUB(423,ODO2)                     ! describe.
  458.       AVEHIC(WINNER)=PRSO
  459.       IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,0,PRSO,0)
  460.       RETURN
  461. C
  462. C V131--        Disembark
  463. C
  464. 31000 IF(AV.EQ.PRSO) GO TO 31100                ! from vehicle?
  465.       CALL RSPEAK(424)                          ! no, joke.
  466.       PRSCON=0                                  ! kill cmd stream.
  467.       RETURN
  468. C
  469. 31100 IF(OBJACT(X)) RETURN                      ! obj handle?
  470.       IF((RFLAG(HERE).AND.RLAND).NE.0) GO TO 31200
  471.       CALL RSPEAK(425)                          ! not on land.
  472.       PRSCON=0                                  ! kill cmd stream.
  473.       RETURN
  474. C
  475. 31200 AVEHIC(WINNER)=0
  476.       CALL RSPEAK(426)
  477.       IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,HERE,0,0)
  478.       RETURN
  479. C
  480. C V132--        Take
  481. C
  482. 32000 VAPPLI=TAKE(.TRUE.)
  483.       RETURN
  484. C
  485. C V133--        Inventory
  486. C
  487. 33000 CALL INVENT(WINNER)
  488.       RETURN
  489.  
  490. C VAPPLI, PAGE 8
  491. C
  492. C V134--        Fill
  493. C
  494. 34000 IF(PRSI.NE.0) GO TO 34050                 ! any obj specified?
  495.       IF((RFLAG(HERE).AND.(RWATER+RFILL)).NE.0) GO TO 34025
  496.       CALL RSPEAK(516)                          ! nothing to fill with.
  497.       PRSWON=.FALSE.                            ! you lose.
  498.       CALL ORPHAN(-1,ACT,PREP1,PRSO,2,' ',0,0)! orphan "fill obj with"
  499.       GO TO 10                                  ! return false.
  500. C
  501. 34025 PRSI=GWATE                                ! use global water.
  502. 34050 IF(OBJACT(X)) RETURN                      ! obj handle?
  503.       IF((PRSI.EQ.GWATE).OR.(PRSI.EQ.WATER)) GO TO 10
  504.       I=PRSO                                    ! fill x with y becomes
  505.       PRSO=PRSI                                 ! put y in x
  506.       PRSI=I
  507.       VAPPLI=PUT(.TRUE.)
  508.       RETURN
  509. C
  510. C V135,V136--   Eat/Drink
  511. C
  512. 35000 CONTINUE
  513. 36000 IF(OBJACT(X)) RETURN                      ! obj handle?
  514.       IF(PRSO.EQ.GWATE) GO TO 36500             ! drink global water?
  515.       IF(.NOT.EDIBLE(PRSO)) GO TO 36400         ! edible?
  516.       IF(OADV(PRSO).EQ.WINNER) GO TO 36200      ! yes, on winner?
  517. 36100 CALL RSPSUB(454,ODO2)                     ! not accessible.
  518.       RETURN
  519. C
  520. 36200 IF(PRSA.EQ.DRINKW) GO TO 36300            ! drink food?
  521.       CALL NEWSTA(PRSO,455,0,0,0)               ! no, it disappears.
  522.       RETURN
  523. C
  524. 36300 CALL RSPEAK(456)                          ! yes, joke.
  525.       RETURN
  526. C
  527. 36400 IF(.NOT.DRKBLE(PRSO)) GO TO 36600         ! drinkable?
  528.       IF(OCAN(PRSO).EQ.0) GO TO 36100           ! yes, in something?
  529.       IF(OADV(OCAN(PRSO)).NE.WINNER) GO TO 36100
  530.       IF(QOPEN(OCAN(PRSO))) GO TO 36500         ! cont open?
  531.       CALL RSPEAK(457)                          ! no, joke.
  532.       RETURN
  533. C
  534. 36500 CALL NEWSTA(PRSO,458,0,0,0)               ! gone.
  535.       RETURN
  536. C
  537. 36600 CALL RSPSUB(453,ODO2)                     ! not food or drink.
  538.       RETURN
  539. C
  540. C V137--        Burn
  541. C
  542. 37000 IF((OFLAG1(PRSI).AND.(FLAMBT+LITEBT+ONBT)).NE.
  543.      1(FLAMBT+LITEBT+ONBT)) GO TO 37600                 ! with flame?
  544.       IF(OBJACT(X)) RETURN                      ! obj handle?
  545.       IF((OFLAG1(PRSO).AND.BURNBT).EQ.0) GO TO 37500 ! burnable?
  546.       IF(OADV(PRSO).EQ.WINNER) GO TO 37400      ! carrying it?
  547.       IF(QHERE(PRSO,HERE)) GO TO 37200          ! here?
  548.       J=OCAN(PRSO)                              ! get container.
  549.       IF(J.EQ.0) GO TO 37100                    ! is there one?
  550.       IF(.NOT.QOPEN(J)) GO TO 37100             ! open?
  551.       IF(J.EQ.RECEP) GO TO 37300                ! in balloon receptacle?
  552.       IF(OADV(J).EQ.WINNER) GO TO 37400         ! carrying?
  553.       IF(QHERE(J,HERE)) GO TO 37200             ! here?
  554. 37100 CALL RSPEAK(461)                          ! cant reach it.
  555.       RETURN
  556. C
  557. 37200 CALL RSPSUB(462,ODO2)                     ! burn it.
  558.       CALL NEWSTA(PRSO,0,0,0,0)
  559.       RETURN
  560. C
  561. 37300 VAPPLI=OAPPLI(OACTIO(BALLO),0)            ! fire in receptacle.
  562.       RETURN
  563. C
  564. 37400 CALL RSPSUB(459,ODO2)                     ! burnable on player.
  565.       CALL JIGSUP(460)
  566.       RETURN
  567. C
  568. 37500 CALL RSPSUB(463,ODO2)                     ! cant burn it.
  569.       RETURN
  570. C
  571. 37600 CALL RSPSUB(301,ODI2)                     ! cant burn it with that.
  572.       RETURN
  573.  
  574. C VAPPLI, PAGE 9
  575. C
  576. C V138--        Mung
  577. C
  578. 38000 I=466                                     ! choose phrase.
  579.       IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 41100
  580.       IF(.NOT.OBJACT(X)) CALL RSPSB2(466,ODO2,RMK)
  581.       RETURN
  582. C
  583. C V139--        Kill
  584. C
  585. 39000 I=467                                     ! choose phrase.
  586.       GO TO 41100
  587. C
  588. C V140--        Swing
  589. C
  590. 40000 J=PRSO                                    ! invert.
  591.       PRSO=PRSI
  592.       PRSI=J
  593.       J=ODO2
  594.       ODO2=ODI2
  595.       ODI2=J
  596.       PRSA=ATTACW                               ! for objact.
  597. C
  598. C V141--        Attack
  599. C
  600. 41000 I=468
  601. C
  602. C Common mung/attack/swing/kill code.
  603. C
  604. 41100 IF(PRSO.NE.0) GO TO 41200                 ! anything?
  605.       CALL RSPEAK(469)                          ! no, joke.
  606.       RETURN
  607. C
  608. 41200 IF(OBJACT(X)) RETURN                      ! obj handle?
  609.       IF((OFLAG2(PRSO).AND.VILLBT).NE.0) GO TO 41300
  610.       IF((OFLAG1(PRSO).AND.VICTBT).EQ.0)
  611.      1CALL RSPSUB(470,ODO2)                     ! not a villain.
  612.       RETURN
  613. C
  614. 41300 J=471                                     ! assume no weapon.
  615.       IF(PRSI.EQ.0) GO TO 41500
  616.       IF((OFLAG2(PRSI).AND.WEAPBT).EQ.0) GO TO 41400
  617.       MELEE=1                                   ! assume sword.
  618.       IF(PRSI.NE.SWORD) MELEE=2                 ! must be knife.
  619.       I=BLOW(PLAYER,PRSO,MELEE,.TRUE.,0)        ! strike blow.
  620.       RETURN
  621. C
  622. 41400 J=472                                     ! not a weapon.
  623. 41500 CALL RSPSB2(I,ODO2,J)                     ! joke.
  624.       RETURN
  625.  
  626. C VAPPLI, PAGE 10
  627. C
  628. C V142--        Walk
  629. C
  630. 42000 VAPPLI=WALK(X)
  631.       RETURN
  632. C
  633. C V143--        Tell
  634. C
  635. 43000 CALL RSPEAK(603)
  636.       PRSCON=0                                  ! kill cmd stream.
  637.       RETURN
  638. C
  639. C V144--        Put
  640. C
  641. 44000 VAPPLI=PUT(.TRUE.)
  642.       RETURN
  643. C
  644. C V145,V148--   Drop/Throw
  645. C
  646. 45000 CONTINUE                                  ! throw.
  647. 48000 VAPPLI=DROP(.TRUE.)                       ! drop.
  648.       RETURN
  649. C
  650. C V146--        Give
  651. C
  652. 46000 IF(OADV(PRSO).EQ.WINNER) GO TO 46100      ! is he carrying obj?
  653.       X=OCAN(PRSO)                              ! get container.
  654.       IF(X.EQ.0) GO TO 46200                    ! container?
  655.       IF(.NOT.QOPEN(X)) GO TO 46200             ! open?
  656.       IF(OADV(X).NE.WINNER) GO TO 46200         ! carrying?
  657. 46100 VAPPLI=OBJACT(X)                          ! iobject must handle.
  658.       RETURN
  659. C
  660. 46200 CALL RSPEAK(527)                          ! don't have it.
  661.       RETURN
  662. C
  663. C V147--        Pour
  664. C
  665. 47000 IF(PRSO.EQ.WATER) GO TO 47100             ! pour? must be water.
  666.       CALL RSPEAK(1075)                         ! otherwise, joke.
  667.       RETURN
  668. C
  669. 47100 IF(PRSI.EQ.0) GO TO 48000                 ! pour x, treat like drop.
  670.       PRSA=PUTW                                 ! else, treat like put.
  671.       VAPPLI=PUT(.TRUE.)
  672.       RETURN
  673. C
  674. C V149--        Save
  675. C
  676. 49000 IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 49100
  677.       CALL RSPEAK(828)                          ! no saves in endgame.
  678.       RETURN
  679. C
  680. 49100 CALL SAVEGM                               ! save game.
  681.       PRSWON=.FALSE.                            ! disable rest of move.
  682.       PRSCON=0
  683.       RETURN
  684. C
  685. C V150--        Restore
  686. C
  687. 50000 IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 50100
  688.       CALL RSPEAK(829)                          ! no restores in endgame.
  689.       RETURN
  690. C
  691. 50100 CALL RSTRGM                               ! restore game.
  692.       PRSWON=.FALSE.                            ! disable rest of move.
  693.       PRSCON=0
  694.       RETURN
  695.  
  696. C VAPPLI, PAGE 11
  697. C
  698. C V151--        Hello
  699. C
  700. 51000 IF(PRSO.NE.0) GO TO 51100                 ! any obj?
  701.       CALL RSPEAK(346+RND(4))                   ! no, vanilla hello.
  702.       RETURN
  703. C
  704. 51100 IF(PRSO.NE.AVIAT) GO TO 51200             ! hello aviator?
  705.       CALL RSPEAK(350)                          ! nothing happens.
  706.       RETURN
  707. C
  708. 51200 IF(PRSO.NE.SAILO) GO TO 51300             ! hello sailor?
  709.       HS=HS+1                                   ! count.
  710.       I=351                                     ! give normal or
  711.       IF(MOD(HS,10).EQ.0) I=352                 ! random message.
  712.       IF(MOD(HS,20).EQ.0) I=353
  713.       CALL RSPEAK(I)                            ! speak up.
  714.       RETURN
  715. C
  716. 51300 IF(OBJACT(X)) RETURN                      ! obj handle?
  717.       I=354                                     ! assume villain.
  718.       IF((OFLAG2(PRSO).AND.(VILLBT+ACTRBT)).EQ.0) I=355
  719.       CALL RSPSUB(I,ODO2)                       ! hello there!
  720.       RETURN
  721. C
  722. C V152--        Look into
  723. C
  724. 52000 IF(OBJACT(X)) RETURN                      ! obj handle?
  725.       IF((OFLAG1(PRSO).AND.DOORBT).EQ.0) GO TO 52300 ! door?
  726.       IF(.NOT.QOPEN(PRSO)) GO TO 52200          ! open?
  727.       CALL RSPSUB(628,ODO2)                     ! open door- uninteresting.
  728.       RETURN
  729. C
  730. 52200 CALL RSPSUB(525,ODO2)                     ! closed door- cant see.
  731.       RETURN
  732. C
  733. 52300 IF((OFLAG1(PRSO).AND.CONTBT).NE.0) GO TO 52500 ! container?
  734.       IF(QOPEN(PRSO)) GO TO 52400               ! open anyway?
  735.       CALL RSPSUB(630,ODO2)                     ! cant look inside.
  736.       RETURN
  737. C
  738. 52400 IF(.NOT.QEMPTY(PRSO)) GO TO 52700         ! not empty?
  739.       CALL RSPSUB(1054,ODO2)                    ! doesn't contain anything.
  740.       RETURN
  741. C
  742. 52500 IF(QOPEN(PRSO).OR.((OFLAG1(PRSO).AND.TRANBT).NE.0))
  743.      1GO TO 52600                               ! open or see inside?
  744.       CALL RSPSUB(525,ODO2)                     ! closed.
  745.       RETURN
  746. C
  747. 52600 IF(QEMPTY(PRSO)) GO TO 52800              ! see in.  empty?
  748. 52700 CALL PRINCO(PRSO,573,.TRUE.)              ! no, list contents.
  749.       RETURN
  750. C
  751. 52800 CALL RSPSUB(629,ODO2)                     ! empty.
  752.       RETURN
  753.  
  754. C VAPPLI, PAGE 12
  755. C
  756. C V153--        Look under
  757. C
  758. 53000 IF(.NOT.OBJACT(X)) CALL RSPEAK(631)       ! object handle?
  759.       RETURN
  760. C
  761. C V154--        Pump
  762. C
  763. 54000 IF((OROOM(PUMP).EQ.HERE).OR.(OADV(PUMP).EQ.WINNER))
  764.      1GO TO 54100                               ! pump here?
  765.       CALL RSPEAK(632)                          ! no.
  766.       RETURN
  767. C
  768. 54100 PRSI=PUMP                                 ! becomes inflate
  769.       PRSA=INFLAW                               ! x with pump.
  770.       GO TO 2000                                ! done.
  771. C
  772. C V155--        Wind
  773. C
  774. 55000 IF(.NOT.OBJACT(X)) CALL RSPSUB(634,ODO2)          ! obj handle?
  775.       RETURN
  776. C
  777. C V156--        Climb
  778. C V157--        Climb up
  779. C V158--        Climb down
  780. C
  781. 56000 CONTINUE
  782. 57000 CONTINUE
  783. 58000 IF(OBJACT(X)) RETURN                      ! object handle?
  784.       I=XUP                                     ! assume up.
  785.       IF(PRSA.EQ.CLMBDW) I=XDOWN                ! unless climb dn.
  786.       F=(OFLAG2(PRSO).AND.CLMBBT).NE.0
  787.       IF(F.AND.FINDXT(I,HERE)) GO TO 58500      ! anything to climb?
  788.       I=657
  789.       IF(F) I=524                               ! variety of jokes.
  790.       IF(.NOT.F .AND.((PRSO.EQ.WALL).OR.(PRSO.EQ.GRWAL).OR.
  791.      1((PRSO.GE.WNORT).AND.(PRSO.LE.WNORT+3))))
  792.      2I=656                                     ! if walls.
  793.       CALL RSPEAK(I)                            ! joke.
  794.       RETURN
  795. C
  796. 58500 PRSA=WALKW                                ! walk
  797.       PRSO=I                                    ! in specified dir.
  798.       GO TO 42000                               ! treat as walk.
  799.  
  800. C VAPPLI, PAGE 13
  801. C
  802. C V160--        Pour on
  803. C
  804. 60000 IF(PRSO.NE.WATER) GO TO 60500             ! pour water?
  805.       IF(OBJACT(X)) RETURN                      ! object handle?
  806.       CALL NEWSTA(WATER,0,0,0,0)                ! vanish water.
  807.       IF(OCAN(PRSI).NE.RECEP) GO TO 60100       ! onto obj in receptacle?
  808.       CALL RSPSUB(977,ODI2)                     ! doesn't work.
  809.       RETURN
  810. C
  811. 60100 IF((OFLAG1(PRSI).AND.(LITEBT+FLAMBT+ONBT)).NE.
  812.      1(LITEBT+FLAMBT+ONBT)) GO TO 60300                 ! on flame?
  813.       IF(PRSI.NE.TORCH) GO TO 60200             ! on torch?
  814.       CALL RSPEAK(978)                          ! doesn't work.
  815.       RETURN
  816. C
  817. 60200 OFLAG1(PRSI)=OFLAG1(PRSI).AND..NOT.ONBT   ! extinguish.
  818.       CALL RSPSUB(979,ODI2)                     ! describe.
  819.       IF(PRSI.EQ.CANDL) CFLAG(CEVCND)=.FALSE.   ! if candle, disable timer.
  820.       IF(PRSI.EQ.MATCH) CTICK(CEVMAT)=0         ! if match, gone.
  821.       GO TO 50                                  ! go see if now dark.
  822. C
  823. 60300 CALL RSPSUB(980,ODI2)                     ! doesn't work.
  824.       RETURN
  825. C
  826. 60500 CALL RSPEAK(981)                          ! not water, joke.
  827.       RETURN
  828. C
  829. C V161--        Put under
  830. C
  831. 61000 IF(OBJACT(X)) RETURN                      ! object handle.
  832.       I=1037                                    ! can't do.
  833.       IF((OFLAG1(PRSO).AND.DOORBT).NE.0) I=982          ! if door, won't fit.
  834.       CALL RSPEAK(I)
  835.       RETURN
  836. C
  837. C V162--        Untie from
  838. C
  839. 62000 IF(((PRSO.EQ.BROPE).AND.(BTIEF.NE.0)).OR.
  840.      1 ((PRSO.EQ.ROPE).AND.(TTIE.EQ.PRSI)).OR.
  841.      2 ((PRSO.EQ.ROPE).AND.(PRSI.EQ.RAILI).AND.DOMEF))
  842.      3 GO TO 62100                              ! untie rope?
  843.       CALL RSPEAK(1070)                         ! not attached to that.
  844.       RETURN
  845. C
  846. 62100 PRSA=UNTIEW                               ! treat as normal untie.
  847.       GO TO 13000
  848.  
  849. C VAPPLI, PAGE 14
  850. C
  851. C V163--        Make
  852. C V169--        Wish
  853. C
  854. 63000 IF(PRSO.NE.GWISH) GO TO 10                ! make a wish?
  855. 69000 IF(HERE.NE.BWELL) GO TO 63100             ! at well?
  856.       IF(OROOM(BAGCO).EQ.HERE) GO TO 63200      ! coins here?
  857.       IF(OROOM(ZORKM).EQ.HERE) GO TO 63300      ! zorkmid here?
  858. 63100 CALL RSPEAK(937)                          ! doesn't work.
  859.       RETURN
  860. C
  861. 63200 CALL NEWSTA(BAGCO,938,0,0,0)              ! vanish coins
  862.       RETURN
  863. C
  864. 63300 CALL NEWSTA(ZORKM,938,0,0,0)              ! vanish zorkmid.
  865.       RETURN
  866. C
  867. C V164--        Oil
  868. C
  869. 64000 IF(PRSI.NE.PUTTY) GO TO 64100             ! with putty?
  870.       IF(OBJACT(X)) RETURN                      ! object handle?
  871.       CALL RSPEAK(904)                          ! doesn't work.
  872.       RETURN
  873. C
  874. 64100 CALL RSPEAK(905)                          ! joke.
  875.       RETURN
  876. C
  877. C V165--        Play
  878. C
  879. 65000 IF(PRSO.NE.STRAD) GO TO 65200             ! play violin?
  880.       IF(PRSI.EQ.0) GO TO 65100                 ! with anything?
  881.       IF((OFLAG2(PRSI).AND.WEAPBT).EQ.0) GO TO 65100
  882.       OTVAL(STRAD)=0                            ! with weapon, ruined.
  883.       CALL RSPEAK(933)
  884.       RETURN
  885. C
  886. 65100 CALL RSPEAK(934)                          ! offensive noise.
  887.       RETURN
  888. C
  889. 65200 IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 10 ! play villain?
  890.       CALL RSPSUB(935,ODO2)                     ! you're dead.
  891.       CALL JIGSUP(0)
  892.       RETURN
  893. C
  894. C V166--        Send
  895. C
  896. 66000 IF(OBJACT(X)) RETURN                      ! object handle?
  897.       I=940                                     ! can't do it.
  898.       IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=941  ! why do it?
  899.       CALL RSPSUB(I,ODO2)
  900.       RETURN
  901.  
  902. C VAPPLI, PAGE 15
  903. C
  904. C V167--        Enter
  905. C
  906. 67000 PRSA=WALKW                                ! treat as walk.
  907.       PRSO=XENTER
  908.       GO TO 42000
  909. C
  910. C V168--        Leave
  911. C
  912. 68000 PRSA=WALKW                                ! treat as walk.
  913.       PRSO=XEXIT
  914.       GO TO 42000
  915. C
  916. C V65-- Room
  917. C
  918. 65001 VAPPLI=RMDESC(2)                          ! describe room only.
  919.       RETURN
  920. C
  921. C V66-- Objects
  922. C
  923. 66001 VAPPLI=RMDESC(1)                          ! describe obj only.
  924.       IF(.NOT.TELFLG) CALL RSPEAK(138)          ! no objects.
  925.       RETURN
  926. C
  927. C V67-- Rname
  928. C
  929. 67001 CALL RSPEAK(RDESC2-HERE)                  ! short room name.
  930.       RETURN
  931. C
  932. C V68-- Squeeze
  933. C
  934. 68001 IF(OBJACT(X)) RETURN                      ! object handle?
  935.       I=901                                     ! can't.
  936.       IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=902  ! don't understand.
  937.       CALL RSPSUB(I,ODO2)
  938.       RETURN
  939. C
  940. C V69-- Smell
  941. C
  942. 69001 CALL RSPSUB(903,ODO2)                     ! joke.
  943.       RETURN
  944.  
  945. C VAPPLI, PAGE 16
  946. C
  947. C V70-- Brief
  948. C
  949. 70000 BRIEFF=.TRUE.                             ! brief descriptions.
  950.       SUPERF=.FALSE.
  951.       CALL RSPEAK(326)
  952.       RETURN
  953. C
  954. C V71-- Verbose
  955. C
  956. 71000 BRIEFF=.FALSE.                            ! long descriptions.
  957.       SUPERF=.FALSE.
  958.       CALL RSPEAK(327)
  959.       RETURN
  960. C
  961. C V72-- Superbrief
  962. C
  963. 72000 SUPERF=.TRUE.
  964.       CALL RSPEAK(328)
  965.       RETURN
  966. C
  967. C V73-- Stay (used in endgame)
  968. C
  969. 73000 IF(WINNER.NE.AMASTR) GO TO 73100          ! tell master, stay.
  970.       CALL RSPEAK(781)                          ! he does.
  971.       CTICK(CEVFOL)=0                           ! not following.
  972.       RETURN
  973. C
  974. 73100 IF(WINNER.EQ.PLAYER) CALL RSPEAK(664)     ! joke.
  975.       RETURN
  976. C
  977. C V74-- Version
  978. C
  979. 74000 WRITE(OUTCH,74010) VMAJ,VMIN,VEDIT
  980. 74010 FORMAT(' V',I1,'.',I1,A)
  981.       TELFLG=.TRUE.
  982.       RETURN
  983. C
  984. C V75-- Swim
  985. C
  986. 75000 I=330                                     ! assume water.
  987.       IF((RFLAG(HERE).AND.(RWATER+RFILL)).EQ.0)
  988.      1I=331+RND(3)                              ! if no water, joke.
  989.       CALL RSPEAK(I)
  990.       RETURN
  991. C
  992. C V76-- Geronimo
  993. C
  994. 76000 IF(AVEHIC(WINNER).EQ.BARRE) GO TO 76100   ! in barrel?
  995.       CALL RSPEAK(334)                          ! no, joke.
  996.       RETURN
  997. C
  998. 76100 CALL JIGSUP(335)                          ! over falls.
  999.       RETURN
  1000. C
  1001. C V77-- Sinbad et al
  1002. C
  1003. 77000 IF((HERE.EQ.MCYCL).AND.(OROOM(CYCLO).EQ.HERE)) GO TO 77100
  1004.       CALL RSPEAK(336)                          ! not here, joke.
  1005.       RETURN
  1006. C
  1007. 77100 CALL NEWSTA(CYCLO,337,0,0,0)              ! cyclops flees.
  1008.       CYCLOF=.TRUE.                             ! set all flags.
  1009.       MAGICF=.TRUE.
  1010.       OFLAG2(CYCLO)=OFLAG2(CYCLO).AND. .NOT.FITEBT
  1011.       RETURN
  1012. C
  1013. C V78-- unused
  1014. C
  1015. 78000 GO TO 10
  1016. C
  1017. C V79-- Pray
  1018. c
  1019. 79000 IF(HERE.NE.TEMP2) GO TO 79050             ! in temple?
  1020.       IF(MOVETO(FORE1,WINNER)) GO TO 79100      ! fore1 still there?
  1021. 79050 CALL RSPEAK(340)                          ! joke.
  1022.       RETURN
  1023. C
  1024. 79100 F=RMDESC(3)                               ! moved, describe.
  1025.       RETURN
  1026. C
  1027. C V80-- Treasure
  1028. c
  1029. 80000 IF(HERE.NE.TEMP1) GO TO 80050             ! in temple?
  1030.       IF(MOVETO(TREAS,WINNER)) GO TO 79100      ! treasure room there?
  1031. 80050 CALL RSPEAK(341)                          ! nothing happens.
  1032.       RETURN
  1033. C
  1034. C V81-- Temple
  1035. c
  1036. 81000 IF(HERE.NE.TREAS) GO TO 81050             ! in treasure?
  1037.       IF(MOVETO(TEMP1,WINNER)) GO TO 79100      ! temp1 still there?
  1038. 81050 CALL RSPEAK(341)                          ! nothing happens.
  1039.       RETURN
  1040. C
  1041. C V82-- Blast
  1042. C
  1043. 82000 I=342                                     ! dont understand.
  1044.       IF(PRSO.EQ.SAFE) I=252                    ! joke for safe.
  1045.       CALL RSPEAK(I)
  1046.       RETURN
  1047. C
  1048. C V83-- Score
  1049. C
  1050. 83000 CALL SCORE(.FALSE.)
  1051.       RETURN
  1052. C
  1053. C V84-- Quit
  1054. C
  1055. 84000 CALL SCORE(.TRUE.)                        ! tell score.
  1056.       IF(.NOT.YESNO(343,10,0)) RETURN           ! ask for y/n decision.
  1057.       STOP ' '                                 ! bye.
  1058.  
  1059. C VAPPLI, PAGE 17
  1060. C
  1061. C V85-- Follow (used in endgame)
  1062. C
  1063. 85000 IF(WINNER.NE.AMASTR) GO TO 85100          ! tell master, follow.
  1064.       CALL RSPEAK(782)
  1065.       CFLAG(CEVFOL)=.TRUE.
  1066.       CTICK(CEVFOL)=-1                          ! starts following.
  1067.       RETURN
  1068. C
  1069. 85100 I=10                                      ! assume ok.
  1070.       IF(PRSO.EQ.0) GO TO 85200                 ! any object?
  1071.       I=964                                     ! joke 1
  1072.       IF((OFLAG2(PRSO).AND.VILLBT).NE.0) I=965  ! joke 2.
  1073. 85200 CALL RSPEAK(I)
  1074.       RETURN
  1075. C
  1076. C V86-- Walk through
  1077. C
  1078. 86000 IF(OBJACT(X)) RETURN                      ! object handle?
  1079.       IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
  1080.      1((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 86100
  1081.       SCOLAC=SCOLRM                             ! walked thru scol.
  1082.       PRSO=0                                    ! fake out fromdr.
  1083.       CFLAG(CEVSCL)=.TRUE.
  1084.       CTICK(CEVSCL)=6                           ! start alarm.
  1085.       CALL RSPEAK(668)                          ! disorient him.
  1086.       F=MOVETO(SCOLRM,WINNER)                   ! into room.
  1087.       F=RMDESC(0)                               ! describe.
  1088.       RETURN
  1089. C
  1090. 86100 IF(HERE.NE.SCOLAC) GO TO 86300            ! on other side of scol?
  1091.       DO 86200 I=1,12,3                         ! walk thru proper wall?
  1092.         IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
  1093.      1GO TO 86500                               ! in specified room?
  1094. 86200 CONTINUE
  1095. C
  1096. 86300 IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 86400 ! tkble?
  1097.       I=669                                     ! no, joke.
  1098.       IF(PRSO.EQ.SCOL) I=670                    ! special joke for scol.
  1099.       CALL RSPSUB(I,ODO2)
  1100.       RETURN
  1101. C
  1102. 86400 I=671                                     ! joke.
  1103.       IF(OROOM(PRSO).NE.0) I=552+RND(6)         ! special jokes if carry.
  1104.       CALL RSPEAK(I)
  1105.       RETURN
  1106. C
  1107. 86500 PRSO=SCOLWL(I+2)                          ! thru scol wall...
  1108.       DO 86600 I=1,8,2                          ! find matching room.
  1109.         IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
  1110. 86600 CONTINUE                                  ! declare new scolrm.
  1111.       CTICK(CEVSCL)=0                           ! cancel alarm.
  1112.       CALL RSPEAK(668)                          ! disorient him.
  1113.       F=MOVETO(BKBOX,WINNER)                    ! back in box room.
  1114.       F=RMDESC(0)
  1115.       RETURN
  1116. C
  1117. C V87-- Ring
  1118. C
  1119. 87000 IF(OBJACT(X)) RETURN                      ! object handle?
  1120.       I=359                                     ! cant ring.
  1121.       IF(PRSO.EQ.BELL) I=360                    ! ding, dong.
  1122.       CALL RSPEAK(I)                            ! joke.
  1123.       RETURN
  1124. C
  1125. C V88-- Brush
  1126. C
  1127. 88000 IF(PRSO.EQ.TEETH) GO TO 88100             ! brush teeth?
  1128.       CALL RSPEAK(362)                          ! no, joke.
  1129.       RETURN
  1130. C
  1131. 88100 IF(PRSI.NE.0) GO TO 88200                 ! with something?
  1132.       CALL RSPEAK(363)                          ! no, joke.
  1133.       RETURN
  1134. C
  1135. 88200 IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
  1136.      1GO TO 88300                               ! with putty?
  1137.       CALL RSPSUB(364,ODI2)                     ! no, joke.
  1138.       RETURN
  1139. C
  1140. 88300 CALL JIGSUP(365)                          ! yes, dead!!!!!
  1141.       RETURN
  1142.  
  1143. C VAPPLI, PAGE 18
  1144. C
  1145. C V89-- Dig
  1146. C
  1147. 89000 IF(PRSI.NE.SHOVE) GO TO 89100             ! shovel?
  1148.       VAPPLI=OBJACT(X)                          ! must handle.
  1149.       RETURN
  1150. C
  1151. 89100 I=392                                     ! assume tool.
  1152.       IF((OFLAG1(PRSI).AND.TOOLBT).EQ.0) I=393
  1153.       CALL RSPSUB(I,ODI2)
  1154.       RETURN
  1155. C
  1156. C V90-- Time
  1157. C
  1158. 90000 CALL GTTIME(K)                            ! get play time.
  1159.       I=K/60
  1160.       J=MOD(K,60)
  1161.       WRITE(OUTCH,90010)
  1162.       IF(I.NE.0) WRITE(OUTCH,90011) I
  1163.       IF(I.GE.2) WRITE(OUTCH,90012)
  1164.       IF(I.EQ.1) WRITE(OUTCH,90013)
  1165.       IF(J.EQ.1) WRITE(OUTCH,90014) J
  1166.       IF(J.NE.1) WRITE(OUTCH,90015) J
  1167.       TELFLG=.TRUE.
  1168.       RETURN
  1169. C
  1170. 90010 FORMAT(' You have been playing Dungeon for ',$)
  1171. 90011 FORMAT('+',I3,' hour',$)
  1172. 90012 FORMAT('+s and ',$)
  1173. 90013 FORMAT('+ and ',$)
  1174. 90014 FORMAT('+',I2,' minute.')
  1175. 90015 FORMAT('+',I2,' minutes.')
  1176. C
  1177. C V91-- Leap
  1178. C
  1179. 91000 IF(PRSO.EQ.0) GO TO 91200                 ! over something?
  1180.       IF(QHERE(PRSO,HERE)) GO TO 91100          ! here?
  1181.       CALL RSPEAK(447)                          ! no, joke.
  1182.       RETURN
  1183. C
  1184. 91100 IF((OFLAG2(PRSO).AND.VILLBT).EQ.0) GO TO 91300
  1185.       CALL RSPSUB(448,ODO2)                     ! cant jump villain.
  1186.       RETURN
  1187. C
  1188. 91200 IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 91300   ! down exit?
  1189.       IF(XTYPE.EQ.XNO) GO TO 91400              ! invalid?
  1190.       IF(XTYPE.NE.XCOND) GO TO 91300            ! conditional?
  1191.       IF(.NOT.FLAGS(XFLAG)) GO TO 91400         ! blocked off?
  1192. 91300 CALL RSPEAK(314+RND(5))                   ! wheeee!
  1193.       RETURN
  1194. C
  1195. 91400 IF(WINNER.EQ.PLAYER) GO TO 91500          ! tell x, jump?
  1196.       CALL JIGSUP(452)                          ! Geronimo!
  1197.       RETURN
  1198. C
  1199. 91500 CALL JIGSUP(449+RND(4))                   ! fatal leap.
  1200.       RETURN
  1201.  
  1202. C VAPPLI, PAGE 19
  1203. C
  1204. C V92-- Lock
  1205. C
  1206. 92000 IF(OBJACT(X)) RETURN                      ! object handle?
  1207.       IF((PRSO.EQ.GRATE).AND..NOT.QOPEN(GRATE).AND.(HERE.EQ.MGRAT))
  1208.      1GO TO 92200                               ! lock closed grate?
  1209. 92100 CALL RSPEAK(464)                          ! not lock grate.
  1210.       RETURN
  1211. C
  1212. 92200 GRUNLF=.FALSE.                            ! grate now locked.
  1213.       CALL RSPEAK(214)
  1214.       TRAVEL(REXIT(HERE)+1)=214                 ! change exit status.
  1215.       RETURN
  1216. C
  1217. C V93-- Unlock
  1218. C
  1219. 93000 IF(OBJACT(X)) RETURN                      ! object handle?
  1220.       IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
  1221.      1GO TO 92100                               ! not unlock grate.
  1222.       IF(PRSI.EQ.KEYS) GO TO 93200              ! got keys?
  1223.       CALL RSPSUB(465,ODI2)                     ! no, joke.
  1224.       RETURN
  1225. C
  1226. 93200 GRUNLF=.TRUE.                             ! unlock grate.
  1227.       CALL RSPEAK(217)
  1228.       TRAVEL(REXIT(HERE)+1)=1041                ! change exit status.
  1229.       RETURN
  1230. C
  1231. C V94-- Diagnose
  1232. C
  1233. 94000 I=FIGHTS(WINNER,.FALSE.)                  ! get fights strength.
  1234.       J=ASTREN(WINNER)                          ! get health.
  1235.       K=MIN0(I+J,4)                             ! get state.
  1236.       IF(.NOT.CFLAG(CEVCUR)) J=0                ! if no wounds.
  1237.       L=MIN0(4,IABS(J))                         ! scale.
  1238.       CALL RSPEAK(473+L)                        ! describe health.
  1239.       I=(30*(-J-1))+CTICK(CEVCUR)               ! compute wait.
  1240.       IF(J.NE.0) WRITE(OUTCH,94100) I
  1241. 94100 FORMAT(' You will be cured after ',I3,' moves.')
  1242.       CALL RSPEAK(478+K)                        ! how much more?
  1243.       IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)   ! how many deaths?
  1244.       RETURN
  1245.  
  1246. C VAPPLI, PAGE 20
  1247. C
  1248. C V95-- Incant
  1249. C
  1250. 95000 IF(WINNER.NE.PLAYER) GO TO 10             ! must do yourself.
  1251.       IF((RFLAG(MREYE).AND.RSEEN).NE.0) GO TO 95800 ! too late?
  1252.       IF(SUBLNT.EQ.0) GO TO 95350               ! any input?
  1253.       PW(1)=' '                                 ! set up parse.
  1254.       PW(2)=' '
  1255.       WP=1
  1256.       CP=1
  1257.       DO 95200 I=1,SUBLNT                       ! scan substring
  1258.         IF(SUBBUF(I:I).NE.' ') GO TO 95150      ! blank?
  1259.         IF(CP.EQ.1) GO TO 95200                 ! anything in word yet?
  1260.         WP=MIN0(2,WP+1)                         ! advance word pointer.
  1261.         CP=1                                    ! reset char pointer.
  1262.         GO TO 95200
  1263. 95150   IF(CP.LE.WRDLNT) PW(WP)(CP:CP)=SUBBUF(I:I) ! add char to word.
  1264.         CP=CP+1
  1265. 95200 CONTINUE
  1266. C
  1267.       IF(PW(1).NE.' ') GO TO 95400              ! any input?
  1268. 95350 CALL RSPEAK(856)                          ! no, ho hum.
  1269. 95375 PRSCON=0                                  ! kill cmd stream.
  1270.       RETURN
  1271. C
  1272. 95400 CALL ENCRYP(PW(1),CH)                     ! compute response.
  1273.       IF(PW(2).NE.' ') GO TO 95600              ! two phrases?
  1274. C
  1275.       IF(SPELLF) GO TO 95550                    ! he's trying to learn.
  1276.       IF((RFLAG(TSTRS).AND.RSEEN).EQ.0) GO TO 95575 ! really in end game?
  1277.       SPELLF=.TRUE.                             ! tell him.
  1278.       TELFLG=.TRUE.
  1279.       WRITE(OUTCH,95510) PW(1)(1:NBLEN(PW(1))),CH
  1280. 95510 FORMAT(' A hollow voice replies: "',A,1X,A,'".')
  1281.       RETURN
  1282. C
  1283. 95550 CALL RSPEAK(857)                          ! he's got one already.
  1284.       GO TO 95375
  1285. C
  1286. 95575 CALL RSPEAK(858)                          ! he's not in endgame.
  1287.       GO TO 95375
  1288. C
  1289. 95600 CALL ENCRYP(PW(2),CH2)                    ! try both ways.
  1290.       IF(SPELLF.OR.((PW(1).NE.CH2).AND.(PW(2).NE.CH)))
  1291.      1 GO TO 95900                              ! wrong or second use.
  1292.       SPELLF=.TRUE.                             ! it works.
  1293.       CALL RSPEAK(859)
  1294.       CFLAG(CEVSTE)=.TRUE.
  1295.       CTICK(CEVSTE)=1                           ! force start.
  1296.       RETURN
  1297. C
  1298. 95800 CALL RSPEAK(855)                          ! too late.
  1299.       GO TO 95375
  1300. C
  1301. 95900 CALL RSPEAK(1052)                         ! got it wrong.
  1302.       GO TO 95375
  1303.  
  1304. C VAPPLI, PAGE 21
  1305. C
  1306. C V96-- Answer
  1307. C
  1308. 96000 IF(WINNER.NE.PLAYER) GO TO 10             ! must answer for himself.
  1309.       IF(SUBLNT.EQ.0) GO TO 96050               ! any substring?
  1310.       IF((HERE.EQ.RIDDL).AND..NOT.RIDDLF) GO TO 96700 ! riddle room?
  1311.       IF(HERE.EQ.FDOOR) GO TO 96100             ! end game front door?
  1312. 96050 CALL RSPEAK(799)                          ! no one listens.
  1313.       PRSCON=0                                  ! kill cmd stream.
  1314.       RETURN
  1315. C
  1316. 96100 IF(INQSTF.AND.(NQATT.LT.5).AND.(CORRCT.LT.3))
  1317.      1GO TO 96200                               ! knocked, didn't lose or win?
  1318.       CALL RSPEAK(783)                          ! no reply.
  1319.       PRSCON=0                                  ! kill cmd stream.
  1320.       RETURN
  1321. C
  1322. 96200 DO 96300 J=1,NUMANS                       ! check answers.
  1323.         IF(QUESNO.NE.ANSWER(J)) GO TO 96300     ! only check proper ans.
  1324.         IF(SUBBUF.EQ.ANSSTR(J)(1:NBLEN(ANSSTR(J)))) GO TO 96500
  1325. 96300 CONTINUE
  1326. C
  1327.       PRSCON=0                                  ! kill cmd stream.
  1328.       NQATT=NQATT+1                             ! wrong, cretin.
  1329.       IF(NQATT.GE.5) GO TO 96400                ! too many wrong?
  1330.       CALL RSPEAK(800+NQATT)                    ! no, try again.
  1331.       RETURN
  1332. C
  1333. 96400 CALL RSPEAK(826)                          ! all over.
  1334.       CFLAG(CEVINQ)=.FALSE.                     ! lose.
  1335.       RETURN
  1336. C
  1337. 96500 CORRCT=CORRCT+1                           ! got it right.
  1338.       CALL RSPEAK(800)                          ! hooray.
  1339.       IF(CORRCT.GE.3) GO TO 96600               ! won totally?
  1340.       CFLAG(CEVINQ)=.TRUE.
  1341.       CTICK(CEVINQ)=2                           ! no, start again.
  1342.       QUESNO=MOD(QUESNO+3,8)
  1343.       NQATT=0
  1344.       CALL RSPEAK(769)                          ! ask next question.
  1345.       CALL RSPEAK(770+QUESNO)
  1346.       RETURN
  1347. C
  1348. 96600 CALL RSPEAK(827)                          ! quiz over,
  1349.       CFLAG(CEVINQ)=.FALSE.
  1350.       OFLAG2(QDOOR)=OFLAG2(QDOOR).OR.OPENBT     ! open door.
  1351.       RETURN
  1352. C
  1353. 96700 IF(SUBBUF.NE.'WELL') GO TO 96050          ! right answer?
  1354.       RIDDLF=.TRUE.                             ! solved riddle.
  1355.       CALL RSPEAK(338)
  1356.       RETURN
  1357.  
  1358. C V97-- Count (valuables, possessions in VALUAC)
  1359. C
  1360. 97000 IF(PRSO.NE.MATCH) GO TO 97100             ! matches?
  1361.       IF(ORMTCH.EQ.1) WRITE(OUTCH,97010) ORMTCH ! print number.
  1362.       IF(ORMTCH.NE.1) WRITE(OUTCH,97020) ORMTCH
  1363. 97010 FORMAT(' You have ',I1,' match.')
  1364. 97020 FORMAT(' You have ',I1,' matches.')
  1365.       TELFLG=.TRUE.
  1366.       RETURN
  1367. C
  1368. 97100 I=1062                                    ! default.
  1369.       IF(PRSO.EQ.BAGCO) I=561                   ! bag of coins.
  1370.       IF(PRSO.EQ.CANDL) I=1058                  ! candles.
  1371.       IF(PRSO.EQ.BILLS) I=1059                  ! stack of bills.
  1372.       IF(PRSO.EQ.LEAVE) I=1060                  ! pile of leaves.
  1373.       IF(PRSO.EQ.GWISH) I=1061                  ! blessings.
  1374.       IF(PRSO.EQ.HEADS) I=1084                  ! heads.
  1375.       CALL RSPEAK(I)                            ! print response.
  1376.       RETURN
  1377. C
  1378.       END
  1379.  
  1380. C TAKE-- Basic take sequence
  1381. C
  1382. C Take an object (for verbs take, put, drop, read, etc.)
  1383. C
  1384.       LOGICAL FUNCTION TAKE(FLG)
  1385. C
  1386. C Declarations
  1387. C
  1388.       IMPLICIT INTEGER (A-Z)
  1389.       LOGICAL FLG,OBJACT,OAPPLI,QHERE
  1390.       INCLUDE 'dparam.for'
  1391.  
  1392. C TAKE, PAGE 2
  1393. C
  1394.       IF((PRSO.LE.STRBIT).AND.
  1395.      1((OFLAG2(PRSO).AND.NOCHBT).EQ.0)) GO TO 100 ! star or nocheck?
  1396.       TAKE=OBJACT(X)                            ! yes, let it handle.
  1397.       RETURN
  1398. C
  1399. 100   TAKE=.FALSE.                              ! assume loses.
  1400.       X=OCAN(PRSO)                              ! inside?
  1401.       IF((PRSI.EQ.0).OR.(PRSI.EQ.X)) GO TO 200  ! take x from ocan(x)?
  1402.       CALL RSPEAK(1038)                         ! not in that.
  1403.       RETURN
  1404. C
  1405. 200   IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400      ! his vehicle?
  1406.       CALL RSPEAK(672)                          ! dummy.
  1407.       RETURN
  1408. C
  1409. 400   IF((OFLAG1(PRSO).AND.TAKEBT).NE.0) GO TO 500 ! takeable?
  1410.       IF(.NOT.OAPPLI(OACTIO(PRSO),0)) CALL RSPEAK(552+RND(6))
  1411.       RETURN
  1412. C
  1413. C Object is takeable and in position to be taken.
  1414. C
  1415. 500   IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600
  1416.       I=103                                     ! assume player.
  1417.       IF(WINNER.NE.PLAYER) I=1080
  1418.       IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(I)   ! already got it?
  1419.       RETURN
  1420. C
  1421. 600   IF(X.EQ.0) GO TO 650                      ! contained?
  1422.       IF(OADV(X).EQ.WINNER) GO TO 700           ! already carrying cont?
  1423. 650   IF((WEIGHR(PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD)
  1424.      2GO TO 700                                 ! can he carry?
  1425.       I=558                                     ! assume player.
  1426.       IF(WINNER.NE.PLAYER) I=1079
  1427.       CALL RSPEAK(I)                            ! too much weight.
  1428.       PRSCON=0                                  ! kill cmd stream.
  1429.       RETURN
  1430. C
  1431. 700   TAKE=.TRUE.                               ! at last.
  1432.       IF(OAPPLI(OACTIO(PRSO),0)) RETURN         ! did it handle?
  1433.       CALL NEWSTA(PRSO,0,0,0,WINNER)            ! take object for winner.
  1434.       OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT        ! has been touched.
  1435.       CALL SCRUPD(OFVAL(PRSO))                  ! update score.
  1436.       OFVAL(PRSO)=0                             ! cant be scored again.
  1437.       IF(FLG) CALL RSPEAK(559)                  ! tell taken.
  1438.       RETURN
  1439. C
  1440.       END
  1441.  
  1442. C DROP- Drop verb processor (also throw, pour water)
  1443. C
  1444. C Declarations
  1445. C
  1446.       LOGICAL FUNCTION DROP(FLG)
  1447.       IMPLICIT INTEGER (A-Z)
  1448.       INCLUDE 'dparam.for'
  1449.       LOGICAL F,PUT,OBJACT,FLG
  1450. C
  1451.       IF((OFLAG2(PRSO).AND.NOCHBT).EQ.0) GO TO 100
  1452.       DROP=OBJACT(X)                            ! no check, let obj handle.
  1453.       RETURN
  1454. C
  1455. 100   DROP=.TRUE.                               ! assume wins.
  1456.       X=OCAN(PRSO)                              ! get container.
  1457.       IF(X.EQ.0) GO TO 200                      ! is it inside?
  1458.       IF(OADV(X).NE.WINNER) GO TO 1000          ! is he carrying con?
  1459.       IF((OFLAG2(X).AND.OPENBT).NE.0) GO TO 300 ! is it open?
  1460.       CALL RSPSUB(525,ODESC2(X))                ! cant reach.
  1461.       RETURN
  1462. C
  1463. 200   IF(OADV(PRSO).NE.WINNER) GO TO 1000       ! is he carrying obj?
  1464. 300   IF(AVEHIC(WINNER).EQ.0) GO TO 400         ! is he in vehicle?
  1465.       PRSI=AVEHIC(WINNER)                       ! yes,
  1466.       F=PUT(.TRUE.)                             ! drop into vehicle.
  1467.       PRSI=0                                    ! disarm parser.
  1468.       RETURN                                    ! done.
  1469. C
  1470. 400   CALL NEWSTA(PRSO,0,HERE,0,0)              ! drop into room.
  1471.       CALL SCRUPD(OFVAL(PRSO))                  ! score object.
  1472.       OFVAL(PRSO)=0                             ! cant be scored again.
  1473.       OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT        ! has been touched.
  1474. C
  1475.       IF(OBJACT(X)) RETURN                      ! did it handle?
  1476.       IF(PRSA.EQ.DROPW) CALL RSPEAK(528)
  1477.       IF(PRSA.EQ.THROWW) CALL RSPEAK(529)
  1478.       RETURN
  1479. C
  1480. 1000  I=527                                     ! assume player.
  1481.       IF(WINNER.NE.PLAYER) I=1078
  1482.       CALL RSPEAK(I)                            ! dont have it.
  1483.       RETURN
  1484. C
  1485.       END
  1486.  
  1487. C PUT- Put verb processor
  1488. C
  1489. C Declarations
  1490. C
  1491.       LOGICAL FUNCTION PUT(FLG)
  1492.       IMPLICIT INTEGER (A-Z)
  1493.       INCLUDE 'dparam.for'
  1494.       LOGICAL QOPEN,QHERE,OBJACT,FLG,TAKE
  1495. C
  1496. C Functions and data
  1497. C
  1498.       QOPEN(R)=(OFLAG2(R).AND.OPENBT).NE.0
  1499.  
  1500. C PUT, PAGE 2
  1501. C
  1502.       IF((OFLAG2(PRSO).AND.NOCHBT).EQ.0) GO TO 100
  1503.       PUT=OBJACT(X)                             ! no check, let obj handle.
  1504.       RETURN
  1505. C
  1506. 100   PUT=.FALSE.
  1507.       IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200
  1508.       IF(.NOT.OBJACT(X)) CALL RSPEAK(560)       ! star
  1509.       PUT=.TRUE.
  1510.       RETURN
  1511. C
  1512. 200   IF(QOPEN(PRSI).OR.((OFLAG1(PRSI).AND.(DOORBT+CONTBT)).NE.0)
  1513.      1.OR.((OFLAG2(PRSI).AND.VEHBT).NE.0)) GO TO 300
  1514.       CALL RSPEAK(561)                          ! cant put in that.
  1515.       RETURN
  1516. C
  1517. 300   IF(QOPEN(PRSI)) GO TO 400                 ! is it open?
  1518.       CALL RSPEAK(562)                          ! no, joke
  1519.       RETURN
  1520. C
  1521. 400   IF(PRSO.NE.PRSI) GO TO 500                ! into itself?
  1522.       CALL RSPEAK(563)                          ! yes, joke.
  1523.       RETURN
  1524. C
  1525. 500   IF(OCAN(PRSO).NE.PRSI) GO TO 600          ! already inside.
  1526.       CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI))
  1527.       PUT=.TRUE.
  1528.       RETURN
  1529. C
  1530. 600   IF((WEIGHR(PRSO,0)+WEIGHR(PRSI,0)+OSIZE(PRSO))
  1531.      1.LE.OCAPAC(PRSI)) GO TO 700               ! not too full?
  1532.       IF(PRSI.NE.AVEHIC(WINNER)) GO TO 650      ! into vehicle?
  1533.       CALL RSPSUB(889,ODESC2(PRSI))             ! too full.
  1534.       RETURN
  1535. C
  1536. 650   CALL RSPEAK(565)                          ! then cant do it.
  1537.       RETURN
  1538. C
  1539. C Now see if object (or its container) is in room
  1540. C
  1541. 700   J=PRSO                                    ! start search.
  1542. 725   IF(QHERE(J,HERE)) GO TO 750               ! is it here?
  1543.       J=OCAN(J)
  1544.       IF(J.NE.0) GO TO 725                      ! more to do?
  1545.       GO TO 800                                 ! no, sch fails.
  1546. C
  1547. 750   IF((PRSO.EQ.WATER).OR.(PRSO.EQ.GWATE)) GO TO 800
  1548.       SVO=PRSO                                  ! save parser.
  1549.       SVI=PRSI
  1550.       PRSA=TAKEW
  1551.       PRSI=0
  1552.       IF(.NOT.TAKE(.FALSE.)) RETURN             ! take object.
  1553.       PRSA=PUTW
  1554.       PRSO=SVO
  1555.       PRSI=SVI
  1556.       GO TO 1000
  1557. C
  1558. C Now see if object is on person.
  1559. C
  1560. 800   IF(OCAN(PRSO).EQ.0) GO TO 1000            ! inside?
  1561.       IF(QOPEN(OCAN(PRSO))) GO TO 900           ! open?
  1562.       CALL RSPSUB(566,ODESC2(PRSO))             ! lose.
  1563.       RETURN
  1564. C
  1565. 900   CALL SCRUPD(OFVAL(PRSO))                  ! score object.
  1566.       OFVAL(PRSO)=0
  1567.       OFLAG2(PRSO)=OFLAG2(PRSO).OR.TCHBT        ! has been touched.
  1568.       CALL NEWSTA(PRSO,0,0,0,WINNER)            ! temporarily on winner.
  1569. C
  1570. 1000  IF(OBJACT(X)) RETURN                      ! no, give object a shot.
  1571.       CALL NEWSTA(PRSO,2,0,PRSI,0)              ! contained inside.
  1572.       PUT=.TRUE.
  1573.       RETURN
  1574. C
  1575.       END
  1576.  
  1577. C VALUAC- Handles valuables/everything/possessions/bunch object
  1578. C         for take, put, drop, count
  1579. C
  1580. C Declarations
  1581. C
  1582.       SUBROUTINE VALUAC(V)
  1583.       IMPLICIT INTEGER (A-Z)
  1584.       INCLUDE 'dparam.for'
  1585.       LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTHIS,NOHERE,QHERE,QBUNCH
  1586. C
  1587. C Functions and data
  1588. C
  1589.       NOTHIS(R)=((SAVEP.EQ.BUNOBJ).AND.QBUNCH(R)) .OR.
  1590.      1  ((OTVAL(R).LE.0).AND.((SAVEP.EQ.VALUA).OR.
  1591.      2   ((SAVEP.EQ.BUNOBJ).AND.(BUNSUB.EQ.VALUA)))) .OR.
  1592.      3  ((OADV(R).NE.WINNER).AND.((SAVEP.EQ.POSSE).OR.
  1593.      4   ((SAVEP.EQ.BUNOBJ).AND.(BUNSUB.EQ.POSSE))))
  1594.  
  1595.       NOHERE(R)=((AV.EQ.0).AND..NOT.QHERE(R,HERE)) .OR.
  1596.      1  ((AV.NE.0).AND.(OCAN(R).NE.AV))
  1597.  
  1598. C VALUAC, PAGE 2
  1599. C Count
  1600. C
  1601.       IF((PRSA.NE.COUNTW).OR.(PRSO.NE.POSSE)) GO TO 100
  1602.       K=0
  1603.       DO 50 J=1,OLNT                            ! count possessions.
  1604.         IF(OADV(J).EQ.WINNER) K=K+1
  1605. 50    CONTINUE
  1606.       IF(K.EQ.1) WRITE(OUTCH,60) K
  1607.       IF(K.NE.1) WRITE(OUTCH,70) K
  1608. 60    FORMAT(' You have ',I1,' possession.')
  1609. 70    FORMAT(' You have ',I2,' possessions.')
  1610.       TELFLG=.TRUE.
  1611.       RETURN
  1612. C
  1613. 100   IF((PRSA.NE.COUNTW).OR.(PRSO.NE.VALUA)) GO TO 200
  1614.       K=0
  1615.       L=0
  1616.       DO 150 J=1,OLNT                           ! count treasures.
  1617.         IF((OADV(J).EQ.WINNER).AND.(OTVAL(J).GT.0)) K=K+1
  1618.         IF((OCAN(J).EQ.TCASE).AND.(OTVAL(J).GT.0)) L=L+1
  1619. 150   CONTINUE
  1620.       IF(K.EQ.1) WRITE(OUTCH,160) K
  1621.       IF(K.NE.1) WRITE(OUTCH,170) K
  1622. 160   FORMAT(' You have ',I1,' valuable.')
  1623. 170   FORMAT(' You have ',I2,' valuables.')
  1624.       TELFLG=.TRUE.
  1625.       IF(HERE.NE.LROOM) RETURN
  1626.       IF(L.EQ.1) WRITE(OUTCH,180) L
  1627.       IF(L.NE.1) WRITE(OUTCH,190) L
  1628. 180   FORMAT(' Your adventure has netted ',I1,' treasure.')
  1629. 190   FORMAT(' Your adventure has netted ',I2,' treasures.')
  1630.       RETURN
  1631.  
  1632. C VALUAC, PAGE 3
  1633. C Take
  1634. C
  1635. 200   SAVEP=PRSO                                ! save prso.
  1636.       SAVEH=HERE                                ! save here.
  1637.       F=.TRUE.                                  ! assume no actions.
  1638.       I=579                                     ! assume not lit.
  1639.       AV=AVEHIC(WINNER)                         ! get vehicle.
  1640. C
  1641.       IF(PRSA.NE.TAKEW) GO TO 1000              ! take?
  1642.       IF(.NOT.LIT(HERE)) GO TO 4500             ! if not lit, punt.
  1643.       IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 400 ! bunch, no except?
  1644.       DO 300 I=1,BUNLNT                         ! loop through bunch.
  1645.         PRSO=BUNVEC(I)                          ! get next item.
  1646.         F=.FALSE.
  1647.         CALL RSPSUB(580,ODESC2(PRSO))
  1648.         F1=TAKE(.TRUE.)
  1649.         IF(SAVEH.NE.HERE) GO TO 4500
  1650. 300   CONTINUE
  1651.       GO TO 4000                                ! go clean up.
  1652. C
  1653. 400   DO 500 PRSO=1,OLNT                        ! loop thru objects.
  1654.         IF((((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND.
  1655.      1((OFLAG2(PRSO).AND.TRYBT).EQ.0)).OR.
  1656.      2((OFLAG1(PRSO).AND.VISIBT).EQ.0).OR.
  1657.      3((OFLAG2(PRSO).AND.ACTRBT).NE.0).OR.
  1658.      4NOTHIS(PRSO)) GO TO 500
  1659.         IF(.NOT.NOHERE(PRSO)) GO TO 450         ! is it here?
  1660.         J=OCAN(PRSO)                            ! get container.
  1661.         IF((J.EQ.0).OR.(PRSO.EQ.WATER)) GO TO 500 ! in a cont?
  1662.         IF(((OFLAG2(J).AND.OPENBT).EQ.0).OR.
  1663.      1(NOHERE(J).AND.(OADV(J).NE.WINNER)))
  1664.      2GO TO 500                                 ! in open cont here?
  1665. C
  1666. 450     F=.FALSE.
  1667.         CALL RSPSUB(580,ODESC2(PRSO))
  1668.         F1=TAKE(.TRUE.)
  1669.         IF(SAVEH.NE.HERE) GO TO 4500
  1670. 500   CONTINUE
  1671.       GO TO 4000                                ! go clean up.
  1672.  
  1673. C VALUAC, PAGE 4
  1674. C Drop
  1675. C
  1676. 1000  IF(PRSA.NE.DROPW) GO TO 2000              ! drop?
  1677.       IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 1400 ! bunch, no except?
  1678.       DO 1300 I=1,BUNLNT                        ! loop through bunch.
  1679.         PRSO=BUNVEC(I)                          ! get next item.
  1680.         F=.FALSE.
  1681.         CALL RSPSUB(580,ODESC2(PRSO))
  1682.         F1=DROP(.TRUE.)
  1683.         IF(SAVEH.NE.HERE) GO TO 4500
  1684. 1300  CONTINUE
  1685.       GO TO 4000                                ! go clean up.
  1686. C
  1687. 1400  DO 1500 PRSO=1,OLNT                       ! loop through inventory.
  1688.         IF((OADV(PRSO).NE.WINNER).OR.NOTHIS(PRSO))
  1689.      1GO TO 1500
  1690.         F=.FALSE.
  1691.         CALL RSPSUB(580,ODESC2(PRSO))
  1692.         F1=DROP(.TRUE.)
  1693.         IF(SAVEH.NE.HERE) GO TO 4500
  1694. 1500  CONTINUE
  1695.       GO TO 4000                                ! go clean up.
  1696.  
  1697. C VALUAC, PAGE 5
  1698. C Put
  1699. C
  1700. 2000  IF(PRSA.NE.PUTW) GO TO 3000               ! put?
  1701.       IF(.NOT.LIT(HERE)) GO TO 4500             ! if not lit, punt.
  1702.       IF((PRSO.NE.BUNOBJ).OR.(BUNSUB.NE.0)) GO TO 2400 ! bunch, no except?
  1703.       DO 2300 I=1,BUNLNT                        ! loop through bunch.
  1704.         PRSO=BUNVEC(I)                          ! get next item.
  1705.         F=.FALSE.
  1706.         CALL RSPSUB(580,ODESC2(PRSO))
  1707.         F1=PUT(.TRUE.)
  1708.         IF(SAVEH.NE.HERE) GO TO 4500
  1709. 2300  CONTINUE
  1710.       GO TO 4000                                ! go clean up.
  1711. C
  1712. 2400  DO 2500 PRSO=1,OLNT                       ! loop thru objects.
  1713.         IF(((OADV(PRSO).NE.WINNER).AND.
  1714.      1(NOHERE(PRSO).OR.
  1715.      2(((OFLAG1(PRSO).AND.TAKEBT).EQ.0).AND.
  1716.      3 ((OFLAG2(PRSO).AND.TRYBT).EQ.0)))) .OR.
  1717.      4(PRSO.EQ.PRSI).OR.NOTHIS(PRSO).OR.
  1718.      5((OFLAG1(PRSO).AND.VISIBT).EQ.0)) GO TO 2500
  1719.         F=.FALSE.
  1720.         CALL RSPSUB(580,ODESC2(PRSO))
  1721.         F1=PUT(.TRUE.)
  1722.         IF(SAVEH.NE.HERE) GO TO 4500
  1723. 2500  CONTINUE
  1724.       GO TO 4000                                ! go clean up.
  1725. C
  1726. C Wrong verb.
  1727. C
  1728. 3000  I=677                                     ! wrong verb.
  1729.       GO TO 4500
  1730. C
  1731. C Clean up.
  1732. C
  1733. 4000  I=581                                     ! right verb, choose
  1734.       IF(SAVEP.EQ.VALUA) I=582                  ! nothing happened message.
  1735. 4500  IF(F) CALL RSPEAK(I)                      ! not lit, nothing, wrong verb?
  1736.       PRSO=SAVEP                                ! restore PRSO.
  1737.       BUNSUB=0                                  ! cancel EXCEPT/BUT.
  1738.       RETURN
  1739.       END
  1740.  
  1741. C QBUNCH-       Is object in bunch vector?
  1742. C
  1743. C Declarations
  1744. C
  1745.       LOGICAL FUNCTION QBUNCH(OBJ)
  1746.       IMPLICIT INTEGER (A-Z)
  1747.       INCLUDE 'dparam.for'
  1748. C
  1749.       IF(BUNLNT.EQ.0) GO TO 200                 ! bunch vector empty?
  1750.       QBUNCH=.TRUE.                             ! assume found.
  1751.       DO 100 I=1,BUNLNT                         ! search bunch vector.
  1752.         IF(OBJ.EQ.BUNVEC(I)) RETURN             ! got one.
  1753. 100   CONTINUE
  1754. 200   QBUNCH=.FALSE.                            ! not found.
  1755.       RETURN
  1756. C
  1757.       END
  1758.  
  1759. C SAVE- Save game state
  1760. C
  1761. C Declarations
  1762. C
  1763.       SUBROUTINE SAVEGM
  1764.       IMPLICIT INTEGER (A-Z)
  1765.       INCLUDE 'dparam.for'
  1766. C
  1767.       IF(SUBLNT.EQ.0) SUBBUF='DSAVE.DAT'
  1768.       OPEN (UNIT=1,FILE=SUBBUF,ACCESS='SEQUENTIAL',
  1769.      1STATUS='UNKNOWN',FORM='UNFORMATTED',ERR=100)
  1770. C
  1771.       CALL GTTIME(I)                            ! get time.
  1772.       WRITE(1) VMAJ,VMIN
  1773.       WRITE(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  1774.      1SWDACT,SWDSTA,CPVEC
  1775.       WRITE(1) I,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  1776.      1LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  1777.       WRITE(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  1778.      1OSIZE,OCAPAC,OROOM,OADV,OCAN
  1779.       WRITE(1) RDESC1,RVAL,RFLAG,TRAVEL
  1780.       WRITE(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  1781.       WRITE(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK,CCNCEL
  1782. C
  1783.       CALL RSPEAK(597)
  1784.       CLOSE (UNIT=1)
  1785.       RETURN
  1786. C
  1787. 100   CALL RSPEAK(598)                          ! cant do it.
  1788.       RETURN
  1789.       END
  1790.  
  1791. C RESTORE- Restore game state
  1792. C
  1793. C Declarations
  1794. C
  1795.       SUBROUTINE RSTRGM
  1796.       IMPLICIT INTEGER (A-Z)
  1797.       INCLUDE 'dparam.for'
  1798. C
  1799.       IF(SUBLNT.EQ.0) SUBBUF='DSAVE.DAT'
  1800.       OPEN (UNIT=1,FILE=SUBBUF,ACCESS='SEQUENTIAL',
  1801.      1STATUS='OLD',MODE='READ',FORM='UNFORMATTED',ERR=100)
  1802. C
  1803.       READ(1) I,J
  1804.       IF((I.NE.VMAJ).OR.(J.NE.VMIN)) GO TO 200
  1805. C
  1806.       READ(1) WINNER,HERE,THFPOS,TELFLG,THFFLG,THFACT,
  1807.      1SWDACT,SWDSTA,CPVEC
  1808.       READ(1) PLTIME,MOVES,DEATHS,RWSCOR,EGSCOR,MXLOAD,
  1809.      1LTSHFT,BLOC,MUNGRM,HS,FROMDR,SCOLRM,SCOLAC
  1810.       READ(1) ODESC1,ODESC2,OFLAG1,OFLAG2,OFVAL,OTVAL,
  1811.      1OSIZE,OCAPAC,OROOM,OADV,OCAN
  1812.       READ(1) RDESC1,RVAL,RFLAG,TRAVEL
  1813.       READ(1) AROOM,ASCORE,AVEHIC,ASTREN,AFLAG
  1814.       READ(1) FLAGS,SWITCH,VPROB,CFLAG,CTICK,CCNCEL
  1815. C
  1816.       CALL RSPEAK(599)
  1817.       CLOSE (UNIT=1)
  1818.       RETURN
  1819. C
  1820. 100   CALL RSPEAK(598)                          ! cant do it.
  1821.       RETURN
  1822. C
  1823. 200   CALL RSPEAK(600)                          ! obsolete version
  1824.       CLOSE (UNIT=1)
  1825.       RETURN
  1826.       END
  1827.  
  1828. C WALK- Move in specified direction
  1829. C
  1830. C Declarations
  1831. C
  1832.       LOGICAL FUNCTION WALK(X)
  1833.       IMPLICIT INTEGER (A-Z)
  1834.       INCLUDE 'dparam.for'
  1835.       LOGICAL FINDXT,QOPEN,LIT,PROB,MOVETO,RMDESC
  1836. C
  1837. C Functions and data
  1838. C
  1839.       QOPEN(O)=(OFLAG2(O).AND.OPENBT).NE.0
  1840.  
  1841. C WALK, PAGE 2
  1842. C
  1843.       WALK=.TRUE.                               ! assume wins.
  1844.       IF((WINNER.NE.PLAYER).OR.LIT(HERE).OR.PROB(25,25))
  1845.      1GO TO 500
  1846.       IF(.NOT.FINDXT(PRSO,HERE)) GO TO 450      ! invalid exit? grue!
  1847.       GO TO (400,200,100,300),XTYPE             ! decode exit type.
  1848.       CALL BUG(9,XTYPE)
  1849. C
  1850. 100   IF(CXAPPL(XACTIO).NE.0) GO TO 400         ! cexit... returned room?
  1851.       IF(FLAGS(XFLAG)) GO TO 400                ! no, flag on?
  1852. 200   CALL JIGSUP(523)                          ! bad exit, grue!
  1853.       RETURN
  1854. C
  1855. 300   IF(CXAPPL(XACTIO).NE.0) GO TO 400         ! door... returned room?
  1856.       IF(QOPEN(XOBJ)) GO TO 400                 ! no, door open?
  1857.       CALL JIGSUP(523)                          ! bad exit, grue!
  1858.       RETURN
  1859. C
  1860. 400   IF(LIT(XROOM1)) GO TO 900                 ! valid room, is it lit?
  1861. 450   CALL JIGSUP(522)                          ! no, grue!
  1862.       RETURN
  1863. C
  1864. C Room is lit, or winner is not player (no grue).
  1865. C
  1866. 500   IF(FINDXT(PRSO,HERE)) GO TO 550           ! exit exist?
  1867. 525   XSTRNG=678                                ! assume wall.
  1868.       IF(PRSO.EQ.XUP) XSTRNG=679                ! if up, cant.
  1869.       IF(PRSO.EQ.XDOWN) XSTRNG=680              ! if down, cant.
  1870.       IF(((RFLAG(HERE).AND.RNWALL).NE.0).AND.(WINNER.EQ.PLAYER))
  1871.      1XSTRNG=524                                ! no wall for player.
  1872.       CALL RSPEAK(XSTRNG)
  1873.       PRSCON=0                                  ! stop cmd stream.
  1874.       RETURN
  1875. C
  1876. 550   GO TO (900,600,700,800),XTYPE             ! branch on exit type.
  1877.       CALL BUG(9,XTYPE)
  1878. C
  1879. 700   IF(CXAPPL(XACTIO).NE.0) GO TO 900         ! cexit... returned room?
  1880.       IF(FLAGS(XFLAG)) GO TO 900                ! no, flag on?
  1881. 600   IF(XSTRNG.EQ.0) GO TO 525                 ! if no reason, use std.
  1882.       CALL RSPEAK(XSTRNG)                       ! deny exit.
  1883.       PRSCON=0                                  ! stop cmd stream.
  1884.       RETURN
  1885. C
  1886. 800   IF(CXAPPL(XACTIO).NE.0) GO TO 900         ! door... returned room?
  1887.       IF(QOPEN(XOBJ)) GO TO 900                 ! no, door open?
  1888.       IF(XSTRNG.EQ.0) XSTRNG=525                ! if no reason, use std.
  1889.       CALL RSPSUB(XSTRNG,ODESC2(XOBJ))
  1890.       PRSCON=0                                  ! stop cmd stream.
  1891.       RETURN
  1892. C
  1893. 900   WALK=MOVETO(XROOM1,WINNER)                ! move to room.
  1894.       IF(WALK) WALK=RMDESC(0)                   ! describe room.
  1895.       RETURN
  1896.       END
  1897.  
  1898. C CXAPPL- Conditional exit processors
  1899. C
  1900. C Declarations
  1901. C
  1902.       INTEGER FUNCTION CXAPPL(RI)
  1903.       IMPLICIT INTEGER (A-Z)
  1904.       INCLUDE 'dparam.for'
  1905. C
  1906.       CXAPPL=0                                  ! no return.
  1907.       IF(RI.EQ.0) RETURN                        ! if no action, done.
  1908.       GO TO (1000,2000,3000,4000,5000,6000,7000,8000,
  1909.      19000,10000,11000,12000,13000,14000,15000),RI
  1910.       CALL BUG(5,RI)
  1911.  
  1912. C CXAPPL, PAGE 2
  1913. C
  1914. C C1-   Coffin-cure
  1915. C
  1916. 1000  EGYPTF=OADV(COFFI).NE.WINNER              ! t if no coffin.
  1917.       RETURN
  1918. C
  1919. C C2-   Carousel exit
  1920. C C5-   Carousel out
  1921. C
  1922. 2000  IF(CAROFF) RETURN                         ! if flipped, nothing.
  1923. 2500  CALL RSPEAK(121)                          ! can't tell directions.
  1924. 5000  I=XELNT(XCOND)*RND(8)                     ! choose random exit.
  1925.       XROOM1=(TRAVEL(REXIT(HERE)+I)).AND.XRMASK
  1926.       CXAPPL=XROOM1                             ! return exit.
  1927.       RETURN
  1928. C
  1929. C C3-   Chimney function
  1930. C
  1931. 3000  LITLDF=.FALSE.                            ! assume heavy load.
  1932.       IF(DEADF) GO TO 3300                      ! if dead, always ok.
  1933.       J=0
  1934.       DO 3100 I=1,OLNT                          ! count objects.
  1935.         IF(OADV(I).EQ.WINNER) J=J+1
  1936. 3100  CONTINUE
  1937. C
  1938.       IF(J.GT.2) RETURN                         ! carrying too much?
  1939.       IF(J.NE.0) GO TO 3200                     ! carrying too little?
  1940.       XSTRNG=890                                ! bad idea.
  1941.       RETURN
  1942. C
  1943. 3200  IF(OADV(LAMP).EQ.WINNER) GO TO 3300       ! no lamp?
  1944.       XSTRNG=446                                ! bad idea.
  1945.       RETURN
  1946. C
  1947. 3300  LITLDF=.TRUE.                             ! he can do it.
  1948.       IF((OFLAG2(DOOR).AND.OPENBT).EQ.0)
  1949.      1OFLAG2(DOOR)=OFLAG2(DOOR).AND. .NOT.TCHBT
  1950.       RETURN
  1951. C
  1952. C C4-   Frobozz flag (Magnet Room, fake exit)
  1953. C C6-   Frobozz flag (Magnet Room, real exit)
  1954. C
  1955. 4000  IF(CAROFF) GO TO 2500                     ! if flipped, go spin.
  1956.       FROBZF=.FALSE.                            ! otherwise, not an exit.
  1957.       RETURN
  1958. C
  1959. 6000  IF(CAROFF) GO TO 2500                     ! if flipped, go spin.
  1960.       FROBZF=.TRUE.                             ! otherwise, an exit.
  1961.       RETURN
  1962.  
  1963. C CXAPPL, PAGE 3
  1964. C
  1965. C C7-   Frobozz flag (bank alarm)
  1966. C
  1967. 7000  FROBZF=.FALSE.                            ! assume fails.
  1968.       J=BILLS                                   ! check for bills.
  1969. 7100  IF(OADV(J).EQ.WINNER) RETURN              ! winner's got it, fail.
  1970.       J=OCAN(J)                                 ! get container.
  1971.       IF(J.NE.0) GO TO 7100                     ! if inside, loop
  1972.       J=PORTR                                   ! check for portrait.
  1973. 7200  IF(OADV(J).EQ.WINNER) RETURN              ! winner's got it, fail.
  1974.       J=OCAN(J)                                 ! get container.
  1975.       IF(J.NE.0) GO TO 7200                     ! if inside, loop
  1976.       FROBZF=.TRUE.                             ! wins.
  1977.       RETURN
  1978. C
  1979. C C8-   Frobozz flag (MRGO)
  1980. C
  1981. 8000  FROBZF=.FALSE.                            ! assume cant move.
  1982.       IF(MLOC.NE.XROOM1) GO TO 8100             ! mirror in way?
  1983.       IF((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XSOUTH)) GO TO 8200
  1984.       IF(MOD(MDIR,180).NE.0) GO TO 8300         ! mirror must be n-s.
  1985.       XROOM1=((XROOM1-MRA)*2)+MRAE              ! calc east room.
  1986.       IF(PRSO.GT.XSOUTH) XROOM1=XROOM1+1        ! if sw/nw, calc west.
  1987. 8100  CXAPPL=XROOM1
  1988.       RETURN
  1989. C
  1990. 8200  XSTRNG=814                                ! assume struc blocks.
  1991.       IF(MOD(MDIR,180).EQ.0) RETURN             ! if mirror n-s, done.
  1992. 8300  LDIR=MDIR                                 ! see which mirror.
  1993.       IF(PRSO.EQ.XSOUTH) LDIR=180
  1994.       XSTRNG=815                                ! mirror blocks.
  1995.       IF(((LDIR.GT.180).AND..NOT.MR1F).OR.
  1996.      1 ((LDIR.LT.180).AND..NOT.MR2F)) XSTRNG=816 ! mirror broken.
  1997.       RETURN
  1998. C
  1999. C C9-   Frobozz flag (MIRIN)
  2000. C
  2001. 9000  IF(MRHERE(HERE).NE.1) GO TO 9100          ! mirror 1 here?
  2002.       IF(MR1F) XSTRNG=805                       ! see if broken.
  2003.       FROBZF=MROPNF                             ! enter if open.
  2004.       RETURN
  2005. C
  2006. 9100  FROBZF=.FALSE.                            ! not here,
  2007.       XSTRNG=817                                ! lose.
  2008.       RETURN
  2009.  
  2010. C CXAPPL, PAGE 4
  2011. C
  2012. C C10-  Frobozz flag (mirror exit)
  2013. C
  2014. 10000 FROBZF=.FALSE.                            ! assume cant.
  2015.       LDIR=((PRSO-XNORTH)/XNORTH)*45            ! xlate dir to degrees.
  2016.       IF(.NOT.MROPNF .OR.
  2017.      1((MOD(MDIR+270,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  2018.      2GO TO 10200                               ! exit via mirror?
  2019.       XROOM1=((MLOC-MRA)*2)+MRAE+1-(MDIR/180)   ! assume e-w exit.
  2020.       IF(MOD(MDIR,180).EQ.0) GO TO 10100        ! if n-s, ok.
  2021.       XROOM1=MLOC+1                             ! assume n exit.
  2022.       IF(MDIR.GT.180) XROOM1=MLOC-1             ! if south.
  2023. 10100 CXAPPL=XROOM1
  2024.       RETURN
  2025. C
  2026. 10200 IF(.NOT.WDOPNF .OR.
  2027.      1((MOD(MDIR+180,360).NE.LDIR).AND.(PRSO.NE.XEXIT)))
  2028.      2RETURN                                    ! exit via open door?
  2029.       XROOM1=MLOC+1                             ! assume n.
  2030.       IF(MDIR.EQ.0) XROOM1=MLOC-1               ! if s.
  2031.       CALL RSPEAK(818)                          ! close door.
  2032.       WDOPNF=.FALSE.
  2033.       CXAPPL=XROOM1
  2034.       RETURN
  2035. C
  2036. C C11-  Maybe door.  Normal message is that door is closed.
  2037. C       But if LCELL.NE.4, door isn't there.
  2038. C
  2039. 11000 IF(LCELL.NE.4) XSTRNG=678                 ! set up msg.
  2040.       RETURN
  2041. C
  2042. C C12-  Frobozz flag (Puzzle Room main entrance)
  2043. C
  2044. 12000 CPHERE=10                                 ! set substate.
  2045.       FROBZF=CPVEC(CPHERE).EQ.0                 ! enter if not blocked.
  2046.       RETURN
  2047. C
  2048. C C13-  CPOUTF (Puzzle Room size entrance)
  2049. C
  2050. 13000 CPHERE=52                                 ! set substate.
  2051.       RETURN
  2052.  
  2053. C CXAPPL, PAGE 5
  2054. C
  2055. C C14-  Frobozz flag (Puzzle Room transitions)
  2056. C
  2057. 14000 FROBZF=.FALSE.                            ! asssume lose.
  2058.       IF(PRSO.NE.XUP) GO TO 14100               ! up?
  2059.       IF(CPHERE.NE.10) RETURN                   ! at exit?
  2060.       XSTRNG=881                                ! assume no ladder.
  2061.       IF(CPVEC(CPHERE+1).NE.-2) RETURN          ! ladder here?
  2062.       CALL RSPEAK(882)                          ! you win.
  2063.       RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN          ! reset seen.
  2064.       FROBZF=.TRUE.                             ! let him out.
  2065.       RETURN
  2066. C
  2067. 14100 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST).OR..NOT.CPOUTF)
  2068.      1GO TO 14200                               ! w exit at door?
  2069.       RFLAG(CPUZZ)=RFLAG(CPUZZ).AND..NOT.RSEEN          ! reset seen.
  2070.       FROBZF=.TRUE.                             ! yes, let him out.
  2071.       RETURN
  2072. C
  2073. 14200 IF((CPHERE.NE.52).OR.(PRSO.NE.XWEST)) GO TO 14250
  2074.       XSTRNG=932                                ! door in way.
  2075.       RETURN
  2076. C
  2077. 14250 DO 14300 I=1,16,2                         ! locate exit.
  2078.         IF(PRSO.EQ.CPDR(I)) GO TO 14400
  2079. 14300 CONTINUE
  2080.       RETURN                                    ! no such exit.
  2081. C
  2082. 14400 J=CPDR(I+1)                               ! get directional offset.
  2083.       NXT=CPHERE+J                              ! get next state.
  2084.       K=8                                       ! get orthogonal dir.
  2085.       IF(J.LT.0) K=-8
  2086.       IF((((IABS(J).EQ.1).OR.(IABS(J).EQ.8)).OR.
  2087.      1  ((CPVEC(CPHERE+K).EQ.0).OR.(CPVEC(NXT-K).EQ.0))).AND.
  2088.      2   (CPVEC(NXT).EQ.0)) GO TO 14500         ! cant do it?
  2089.       RETURN
  2090. C
  2091. 14500 CALL CPGOTO(NXT)                          ! move to state.
  2092.       XROOM1=CPUZZ                              ! stay in room.
  2093.       CXAPPL=XROOM1
  2094.       RETURN
  2095. C
  2096. C C15-  Frobozz flag (slide exit)
  2097. C
  2098. 15000 FROBZF=.TRUE.                             ! works.
  2099.       IF((TTIE.EQ.0).OR.DEADF) RETURN           ! if no rope or dead, cellar.
  2100.       IF(OROOM(TTIE).NE.HERE) RETURN            ! if rope elsewhere, cellar.
  2101.       CALL RSPEAK(1014)                         ! slippery.
  2102.       CFLAG(CEVSLI)=.TRUE.                      ! turn on slide clock.
  2103.       CTICK(CEVSLI)=MAX0(2,100/WEIGHR(0,WINNER))
  2104.       XROOM1=SLID1                              ! on the ropes.
  2105.       CXAPPL=XROOM1
  2106.       RETURN
  2107. C
  2108.       END
  2109.